{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- This modules contains facilites for providing meta-information for
-- program terms, especially node labeling
module Cubix.Language.Info
  (
    -- ** SourcePos
    SourcePos (..)
  , sourceFile
  , sourceRow
  , sourceCol

    -- ** SourceSpan
  , SourceSpan (..)
  , sourceStart
  , sourceEnd
  , mkSourceSpan

    -- ** SourceRange
  , SourceRange (..)
  , rangeStart
  , rangeEnd
  , rangeLength

    -- ** Attrs
  , Attrs
  , attrLabel
  , attrSpan

    -- **  Label
  , Label -- opaque!
  , HasLabel(..)
  , TermLab
  , ppLabel
  , LabelGen -- opaque!
  , HasLabelGen(..)
  , mkConcurrentSupplyLabelGen
  , runConcurrentSupplyLabeler
  , unsafeMkConcurrentSupplyLabelGen
  , debugMakeLabel
  , nextLabel

  , annotateLabel
  , annotateLabelOuter
  , labelProg
  , annotateTop
  , annotateTop'
  , annotateTopAttrs
  , annotateTopAttrs'

  , HFixLab

    -- ** Project
  , Project
  , parseProject
  , rewriteProjectM
  , rewriteProjectWithFilM
  , putProject

  ) where

import Control.Concurrent.Supply ( Supply, freshId, newSupply, splitSupply )
import Control.DeepSeq ( NFData(..) )
import Control.Monad ( forM_, liftM )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.State ( MonadState, StateT(..), evalStateT, runState, state )
import Control.Monad.Trans.Maybe ( MaybeT(..) )
import Data.Data ( Data )
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Typeable ( Typeable )
import GHC.Generics ( Generic )
import System.IO.Unsafe ( unsafePerformIO )

import Control.DeepSeq.Generics ( genericRnf )
import Control.Lens ( Lens', (&), (.=), (.~), (^.), use )
import Control.Lens.TH ( makeClassy, makeLenses )
import Data.Aeson ( FromJSON, ToJSON )
import Data.Hashable ( Hashable )

import Data.Comp.Multi ( All, AnnHFix, AnnTerm, Context, Cxt(..), CxtFunM, E(..), HFix, HFoldable, HFunctor, HTraversable, Term, (:<:), (:&:)(..), appCxt, inj, rewriteEM )

import Cubix.Sin.Compdata.Annotation ( MonadAnnotater(..), annotateM, annotateOuter )

--------------------------------------------------------------------------------
---------------------------------- Labels --------------------------------------
--------------------------------------------------------------------------------
                          
-- | Provides unique labels for AST nodes
newtype Label = Label Int
  deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq, Eq Label
Eq Label =>
(Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Label -> Label -> Ordering
compare :: Label -> Label -> Ordering
$c< :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
>= :: Label -> Label -> Bool
$cmax :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
min :: Label -> Label -> Label
Ord, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
(Int -> ReadS Label)
-> ReadS [Label]
-> ReadPrec Label
-> ReadPrec [Label]
-> Read Label
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Label
readsPrec :: Int -> ReadS Label
$creadList :: ReadS [Label]
readList :: ReadS [Label]
$creadPrec :: ReadPrec Label
readPrec :: ReadPrec Label
$creadListPrec :: ReadPrec [Label]
readListPrec :: ReadPrec [Label]
Read, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show, Typeable, Typeable Label
Typeable Label =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Label -> c Label)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Label)
-> (Label -> Constr)
-> (Label -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Label))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label))
-> ((forall b. Data b => b -> b) -> Label -> Label)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r)
-> (forall u. (forall d. Data d => d -> u) -> Label -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Label -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Label -> m Label)
-> Data Label
Label -> Constr
Label -> DataType
(forall b. Data b => b -> b) -> Label -> Label
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Label -> u
forall u. (forall d. Data d => d -> u) -> Label -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Label -> m Label
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Label)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Label -> c Label
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Label
$ctoConstr :: Label -> Constr
toConstr :: Label -> Constr
$cdataTypeOf :: Label -> DataType
dataTypeOf :: Label -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Label)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Label)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Label)
$cgmapT :: (forall b. Data b => b -> b) -> Label -> Label
gmapT :: (forall b. Data b => b -> b) -> Label -> Label
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Label -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Label -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Label -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Label -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Label -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Label -> m Label
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Label -> m Label
Data, (forall x. Label -> Rep Label x)
-> (forall x. Rep Label x -> Label) -> Generic Label
forall x. Rep Label x -> Label
forall x. Label -> Rep Label x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Label -> Rep Label x
from :: forall x. Label -> Rep Label x
$cto :: forall x. Rep Label x -> Label
to :: forall x. Rep Label x -> Label
Generic)

instance NFData Label where rnf :: Label -> ()
rnf = Label -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance ToJSON Label

makeClassy ''Label


--------------------------------------------------------------------------------
---------------------------------- SourcePos -----------------------------------
--------------------------------------------------------------------------------

data SourcePos = SourcePos { SourcePos -> String
_sourceFile :: !String
                           , SourcePos -> Int
_sourceRow  :: !Int
                           , SourcePos -> Int
_sourceCol  :: !Int
                           }
  deriving (SourcePos -> SourcePos -> Bool
(SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool) -> Eq SourcePos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePos -> SourcePos -> Bool
== :: SourcePos -> SourcePos -> Bool
$c/= :: SourcePos -> SourcePos -> Bool
/= :: SourcePos -> SourcePos -> Bool
Eq, Eq SourcePos
Eq SourcePos =>
(SourcePos -> SourcePos -> Ordering)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> SourcePos)
-> (SourcePos -> SourcePos -> SourcePos)
-> Ord SourcePos
SourcePos -> SourcePos -> Bool
SourcePos -> SourcePos -> Ordering
SourcePos -> SourcePos -> SourcePos
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourcePos -> SourcePos -> Ordering
compare :: SourcePos -> SourcePos -> Ordering
$c< :: SourcePos -> SourcePos -> Bool
< :: SourcePos -> SourcePos -> Bool
$c<= :: SourcePos -> SourcePos -> Bool
<= :: SourcePos -> SourcePos -> Bool
$c> :: SourcePos -> SourcePos -> Bool
> :: SourcePos -> SourcePos -> Bool
$c>= :: SourcePos -> SourcePos -> Bool
>= :: SourcePos -> SourcePos -> Bool
$cmax :: SourcePos -> SourcePos -> SourcePos
max :: SourcePos -> SourcePos -> SourcePos
$cmin :: SourcePos -> SourcePos -> SourcePos
min :: SourcePos -> SourcePos -> SourcePos
Ord, ReadPrec [SourcePos]
ReadPrec SourcePos
Int -> ReadS SourcePos
ReadS [SourcePos]
(Int -> ReadS SourcePos)
-> ReadS [SourcePos]
-> ReadPrec SourcePos
-> ReadPrec [SourcePos]
-> Read SourcePos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SourcePos
readsPrec :: Int -> ReadS SourcePos
$creadList :: ReadS [SourcePos]
readList :: ReadS [SourcePos]
$creadPrec :: ReadPrec SourcePos
readPrec :: ReadPrec SourcePos
$creadListPrec :: ReadPrec [SourcePos]
readListPrec :: ReadPrec [SourcePos]
Read, Int -> SourcePos -> ShowS
[SourcePos] -> ShowS
SourcePos -> String
(Int -> SourcePos -> ShowS)
-> (SourcePos -> String)
-> ([SourcePos] -> ShowS)
-> Show SourcePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePos -> ShowS
showsPrec :: Int -> SourcePos -> ShowS
$cshow :: SourcePos -> String
show :: SourcePos -> String
$cshowList :: [SourcePos] -> ShowS
showList :: [SourcePos] -> ShowS
Show, Typeable, Typeable SourcePos
Typeable SourcePos =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourcePos -> c SourcePos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourcePos)
-> (SourcePos -> Constr)
-> (SourcePos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourcePos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos))
-> ((forall b. Data b => b -> b) -> SourcePos -> SourcePos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourcePos -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourcePos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> Data SourcePos
SourcePos -> Constr
SourcePos -> DataType
(forall b. Data b => b -> b) -> SourcePos -> SourcePos
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
$ctoConstr :: SourcePos -> Constr
toConstr :: SourcePos -> Constr
$cdataTypeOf :: SourcePos -> DataType
dataTypeOf :: SourcePos -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cgmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
gmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
Data, (forall x. SourcePos -> Rep SourcePos x)
-> (forall x. Rep SourcePos x -> SourcePos) -> Generic SourcePos
forall x. Rep SourcePos x -> SourcePos
forall x. SourcePos -> Rep SourcePos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePos -> Rep SourcePos x
from :: forall x. SourcePos -> Rep SourcePos x
$cto :: forall x. Rep SourcePos x -> SourcePos
to :: forall x. Rep SourcePos x -> SourcePos
Generic)

instance NFData SourcePos where rnf :: SourcePos -> ()
rnf = SourcePos -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Hashable SourcePos
instance ToJSON SourcePos
instance FromJSON SourcePos

makeClassy ''SourcePos


--------------------------------------------------------------------------------
--------------------------------- SourceSpan -----------------------------------
--------------------------------------------------------------------------------

data SourceSpan = SourceSpan { SourceSpan -> SourcePos
_sourceStart :: !SourcePos, SourceSpan -> SourcePos
_sourceEnd :: !SourcePos } deriving (SourceSpan -> SourceSpan -> Bool
(SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool) -> Eq SourceSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceSpan -> SourceSpan -> Bool
== :: SourceSpan -> SourceSpan -> Bool
$c/= :: SourceSpan -> SourceSpan -> Bool
/= :: SourceSpan -> SourceSpan -> Bool
Eq, Eq SourceSpan
Eq SourceSpan =>
(SourceSpan -> SourceSpan -> Ordering)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> Bool)
-> (SourceSpan -> SourceSpan -> SourceSpan)
-> (SourceSpan -> SourceSpan -> SourceSpan)
-> Ord SourceSpan
SourceSpan -> SourceSpan -> Bool
SourceSpan -> SourceSpan -> Ordering
SourceSpan -> SourceSpan -> SourceSpan
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceSpan -> SourceSpan -> Ordering
compare :: SourceSpan -> SourceSpan -> Ordering
$c< :: SourceSpan -> SourceSpan -> Bool
< :: SourceSpan -> SourceSpan -> Bool
$c<= :: SourceSpan -> SourceSpan -> Bool
<= :: SourceSpan -> SourceSpan -> Bool
$c> :: SourceSpan -> SourceSpan -> Bool
> :: SourceSpan -> SourceSpan -> Bool
$c>= :: SourceSpan -> SourceSpan -> Bool
>= :: SourceSpan -> SourceSpan -> Bool
$cmax :: SourceSpan -> SourceSpan -> SourceSpan
max :: SourceSpan -> SourceSpan -> SourceSpan
$cmin :: SourceSpan -> SourceSpan -> SourceSpan
min :: SourceSpan -> SourceSpan -> SourceSpan
Ord, ReadPrec [SourceSpan]
ReadPrec SourceSpan
Int -> ReadS SourceSpan
ReadS [SourceSpan]
(Int -> ReadS SourceSpan)
-> ReadS [SourceSpan]
-> ReadPrec SourceSpan
-> ReadPrec [SourceSpan]
-> Read SourceSpan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SourceSpan
readsPrec :: Int -> ReadS SourceSpan
$creadList :: ReadS [SourceSpan]
readList :: ReadS [SourceSpan]
$creadPrec :: ReadPrec SourceSpan
readPrec :: ReadPrec SourceSpan
$creadListPrec :: ReadPrec [SourceSpan]
readListPrec :: ReadPrec [SourceSpan]
Read, Int -> SourceSpan -> ShowS
[SourceSpan] -> ShowS
SourceSpan -> String
(Int -> SourceSpan -> ShowS)
-> (SourceSpan -> String)
-> ([SourceSpan] -> ShowS)
-> Show SourceSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceSpan -> ShowS
showsPrec :: Int -> SourceSpan -> ShowS
$cshow :: SourceSpan -> String
show :: SourceSpan -> String
$cshowList :: [SourceSpan] -> ShowS
showList :: [SourceSpan] -> ShowS
Show, Typeable, Typeable SourceSpan
Typeable SourceSpan =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourceSpan -> c SourceSpan)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceSpan)
-> (SourceSpan -> Constr)
-> (SourceSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceSpan))
-> ((forall b. Data b => b -> b) -> SourceSpan -> SourceSpan)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceSpan -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceSpan -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan)
-> Data SourceSpan
SourceSpan -> Constr
SourceSpan -> DataType
(forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceSpan -> c SourceSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceSpan
$ctoConstr :: SourceSpan -> Constr
toConstr :: SourceSpan -> Constr
$cdataTypeOf :: SourceSpan -> DataType
dataTypeOf :: SourceSpan -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceSpan)
$cgmapT :: (forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
gmapT :: (forall b. Data b => b -> b) -> SourceSpan -> SourceSpan
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceSpan -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourceSpan -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceSpan -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceSpan -> m SourceSpan
Data, (forall x. SourceSpan -> Rep SourceSpan x)
-> (forall x. Rep SourceSpan x -> SourceSpan) -> Generic SourceSpan
forall x. Rep SourceSpan x -> SourceSpan
forall x. SourceSpan -> Rep SourceSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceSpan -> Rep SourceSpan x
from :: forall x. SourceSpan -> Rep SourceSpan x
$cto :: forall x. Rep SourceSpan x -> SourceSpan
to :: forall x. Rep SourceSpan x -> SourceSpan
Generic)

instance NFData SourceSpan where rnf :: SourceSpan -> ()
rnf = SourceSpan -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Hashable SourceSpan
instance ToJSON SourceSpan
instance FromJSON SourceSpan

makeClassy ''SourceSpan

mkSourceSpan :: String -> (Int, Int ) -> (Int, Int) -> SourceSpan
mkSourceSpan :: String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan String
fileName (Int
sRow, Int
sCol) (Int
eRow, Int
eCol) = SourcePos -> SourcePos -> SourceSpan
SourceSpan (String -> Int -> Int -> SourcePos
SourcePos String
fileName Int
sRow Int
sCol)
                                                             (String -> Int -> Int -> SourcePos
SourcePos String
fileName Int
eRow Int
eCol)


--------------------------------------------------------------------------------
--------------------------------- SourceSpan -----------------------------------
--------------------------------------------------------------------------------

data SourceRange = SourceRange
  { SourceRange -> Int
_rangeStart :: !Int
  , SourceRange -> Int
_rangeEnd   :: !Int
  }
  deriving (SourceRange -> SourceRange -> Bool
(SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> Bool) -> Eq SourceRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceRange -> SourceRange -> Bool
== :: SourceRange -> SourceRange -> Bool
$c/= :: SourceRange -> SourceRange -> Bool
/= :: SourceRange -> SourceRange -> Bool
Eq, Eq SourceRange
Eq SourceRange =>
(SourceRange -> SourceRange -> Ordering)
-> (SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> SourceRange)
-> (SourceRange -> SourceRange -> SourceRange)
-> Ord SourceRange
SourceRange -> SourceRange -> Bool
SourceRange -> SourceRange -> Ordering
SourceRange -> SourceRange -> SourceRange
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceRange -> SourceRange -> Ordering
compare :: SourceRange -> SourceRange -> Ordering
$c< :: SourceRange -> SourceRange -> Bool
< :: SourceRange -> SourceRange -> Bool
$c<= :: SourceRange -> SourceRange -> Bool
<= :: SourceRange -> SourceRange -> Bool
$c> :: SourceRange -> SourceRange -> Bool
> :: SourceRange -> SourceRange -> Bool
$c>= :: SourceRange -> SourceRange -> Bool
>= :: SourceRange -> SourceRange -> Bool
$cmax :: SourceRange -> SourceRange -> SourceRange
max :: SourceRange -> SourceRange -> SourceRange
$cmin :: SourceRange -> SourceRange -> SourceRange
min :: SourceRange -> SourceRange -> SourceRange
Ord, ReadPrec [SourceRange]
ReadPrec SourceRange
Int -> ReadS SourceRange
ReadS [SourceRange]
(Int -> ReadS SourceRange)
-> ReadS [SourceRange]
-> ReadPrec SourceRange
-> ReadPrec [SourceRange]
-> Read SourceRange
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SourceRange
readsPrec :: Int -> ReadS SourceRange
$creadList :: ReadS [SourceRange]
readList :: ReadS [SourceRange]
$creadPrec :: ReadPrec SourceRange
readPrec :: ReadPrec SourceRange
$creadListPrec :: ReadPrec [SourceRange]
readListPrec :: ReadPrec [SourceRange]
Read, Int -> SourceRange -> ShowS
[SourceRange] -> ShowS
SourceRange -> String
(Int -> SourceRange -> ShowS)
-> (SourceRange -> String)
-> ([SourceRange] -> ShowS)
-> Show SourceRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceRange -> ShowS
showsPrec :: Int -> SourceRange -> ShowS
$cshow :: SourceRange -> String
show :: SourceRange -> String
$cshowList :: [SourceRange] -> ShowS
showList :: [SourceRange] -> ShowS
Show, Typeable, Typeable SourceRange
Typeable SourceRange =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourceRange -> c SourceRange)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceRange)
-> (SourceRange -> Constr)
-> (SourceRange -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceRange))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceRange))
-> ((forall b. Data b => b -> b) -> SourceRange -> SourceRange)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceRange -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceRange -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceRange -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceRange -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceRange -> m SourceRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceRange -> m SourceRange)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceRange -> m SourceRange)
-> Data SourceRange
SourceRange -> Constr
SourceRange -> DataType
(forall b. Data b => b -> b) -> SourceRange -> SourceRange
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
$ctoConstr :: SourceRange -> Constr
toConstr :: SourceRange -> Constr
$cdataTypeOf :: SourceRange -> DataType
dataTypeOf :: SourceRange -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
$cgmapT :: (forall b. Data b => b -> b) -> SourceRange -> SourceRange
gmapT :: (forall b. Data b => b -> b) -> SourceRange -> SourceRange
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
Data, (forall x. SourceRange -> Rep SourceRange x)
-> (forall x. Rep SourceRange x -> SourceRange)
-> Generic SourceRange
forall x. Rep SourceRange x -> SourceRange
forall x. SourceRange -> Rep SourceRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceRange -> Rep SourceRange x
from :: forall x. SourceRange -> Rep SourceRange x
$cto :: forall x. Rep SourceRange x -> SourceRange
to :: forall x. Rep SourceRange x -> SourceRange
Generic)

instance NFData SourceRange where rnf :: SourceRange -> ()
rnf = SourceRange -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Hashable SourceRange
instance ToJSON SourceRange
instance FromJSON SourceRange

instance Semigroup SourceRange where
  SourceRange Int
start1 Int
end1 <> :: SourceRange -> SourceRange -> SourceRange
<> SourceRange Int
start2 Int
end2 = Int -> Int -> SourceRange
SourceRange (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
start1 Int
start2) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
end1 Int
end2)

makeClassy ''SourceRange

point :: Int -> SourceRange
point :: Int -> SourceRange
point Int
i = Int -> Int -> SourceRange
SourceRange Int
i Int
i

-- | Return the length of the range.
rangeLength :: SourceRange -> Int
rangeLength :: SourceRange -> Int
rangeLength SourceRange
range = SourceRange -> Int
_rangeEnd SourceRange
range Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourceRange -> Int
_rangeStart SourceRange
range

subtractRange :: SourceRange -> SourceRange -> SourceRange
subtractRange :: SourceRange -> SourceRange -> SourceRange
subtractRange (SourceRange Int
start1 Int
end1) (SourceRange Int
start2 Int
end2) =
  Int -> Int -> SourceRange
SourceRange Int
start1 (Int
end1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourceRange -> Int
rangeLength (Int -> Int -> SourceRange
SourceRange Int
start2 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
end1 Int
end2)))


--------------------------------------------------------------------------------
------------------------------------ Attrs -------------------------------------
--------------------------------------------------------------------------------

data Attrs = Attrs { Attrs -> Label
_attrLabel :: !Label
                   , Attrs -> Maybe SourceSpan
_attrSpan  :: !(Maybe SourceSpan)
                   }

makeClassy ''Attrs



--------------------------------------------------------------------------------
-------------------------------- Uncategorized ---------------------------------
--------------------------------------------------------------------------------

type TermLab f   = AnnTerm Label f
type TermAttrs f = AnnTerm Attrs f

type HFixLab f   = AnnHFix Label f
type HFixAttrs f = AnnHFix Attrs f

ppLabel :: Label -> String
ppLabel :: Label -> String
ppLabel (Label Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n

data LabelGen = forall a. LabelGenInterface a => LabelGen a

class LabelGenInterface g where
  genLabel :: g -> (Label, LabelGen)
  split    :: g -> (LabelGen, LabelGen)

class HasLabelGen s where
  labelGen :: Lens' s LabelGen

instance HasLabelGen LabelGen where
  labelGen :: Lens' LabelGen LabelGen
labelGen = (LabelGen -> f LabelGen) -> LabelGen -> f LabelGen
forall a. a -> a
id

instance {-# OVERLAPS #-} (Monad m, HasLabelGen s) => MonadAnnotater Label (StateT s m) where
  annM :: forall (f :: Node) (e :: * -> *) l.
f e l -> StateT s m ((:&:) f Label e l)
annM f e l
t = f e l -> Label -> (:&:) f Label e l
forall (f :: Node) a (g :: * -> *) e. f g e -> a -> (:&:) f a g e
(:&:) f e l
t (Label -> (:&:) f Label e l)
-> StateT s m Label -> StateT s m ((:&:) f Label e l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m Label
forall s (m :: * -> *). (MonadState s m, HasLabelGen s) => m Label
nextLabel

-- | Allows embedding a smaller state inside a larger one
-- This has major advantages over 'Control.Lens.Zoom.zoom' in
-- that it doesn't require an explicit monad stack.
--
-- However, it runs the risk of behavior changing due to noncommutative
-- monad transformers (accessed via e.g.: @lift . put@), and is incompatible
-- with RWST.
zoom :: (MonadState s m) => Lens' s t -> StateT t m a -> m a
zoom :: forall s (m :: * -> *) t a.
MonadState s m =>
Lens' s t -> StateT t m a -> m a
zoom Lens' s t
f StateT t m a
m = do t
s <- Getting t s t -> m t
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting t s t
Lens' s t
f
              (a
a, t
s') <- StateT t m a -> t -> m (a, t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT t m a
m t
s
              (t -> Identity t) -> s -> Identity s
Lens' s t
f ((t -> Identity t) -> s -> Identity s) -> t -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= t
s'
              return a
a

nextLabel :: (MonadState s m, HasLabelGen s) => m Label
nextLabel :: forall s (m :: * -> *). (MonadState s m, HasLabelGen s) => m Label
nextLabel = Lens' s LabelGen -> StateT LabelGen m Label -> m Label
forall s (m :: * -> *) t a.
MonadState s m =>
Lens' s t -> StateT t m a -> m a
zoom (LabelGen -> f LabelGen) -> s -> f s
forall s. HasLabelGen s => Lens' s LabelGen
Lens' s LabelGen
labelGen (StateT LabelGen m Label -> m Label)
-> StateT LabelGen m Label -> m Label
forall a b. (a -> b) -> a -> b
$ (LabelGen -> (Label, LabelGen)) -> StateT LabelGen m Label
forall a. (LabelGen -> (a, LabelGen)) -> StateT LabelGen m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(LabelGen a
g) -> a -> (Label, LabelGen)
forall g. LabelGenInterface g => g -> (Label, LabelGen)
genLabel a
g)

--------------------------------------------------------------------------------

data ConcurrentSupplyLabelGen = ConcurrentSupplyLabelGen
    { ConcurrentSupplyLabelGen -> Supply
_supply :: Supply
    }
  deriving ( ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
(ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> Eq ConcurrentSupplyLabelGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
== :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c/= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
/= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
Eq, Eq ConcurrentSupplyLabelGen
Eq ConcurrentSupplyLabelGen =>
(ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool)
-> (ConcurrentSupplyLabelGen
    -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> (ConcurrentSupplyLabelGen
    -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> Ord ConcurrentSupplyLabelGen
ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
compare :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Ordering
$c< :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
< :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c<= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
<= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c> :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
> :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$c>= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
>= :: ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen -> Bool
$cmax :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
max :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
$cmin :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
min :: ConcurrentSupplyLabelGen
-> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
Ord, Int -> ConcurrentSupplyLabelGen -> ShowS
[ConcurrentSupplyLabelGen] -> ShowS
ConcurrentSupplyLabelGen -> String
(Int -> ConcurrentSupplyLabelGen -> ShowS)
-> (ConcurrentSupplyLabelGen -> String)
-> ([ConcurrentSupplyLabelGen] -> ShowS)
-> Show ConcurrentSupplyLabelGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcurrentSupplyLabelGen -> ShowS
showsPrec :: Int -> ConcurrentSupplyLabelGen -> ShowS
$cshow :: ConcurrentSupplyLabelGen -> String
show :: ConcurrentSupplyLabelGen -> String
$cshowList :: [ConcurrentSupplyLabelGen] -> ShowS
showList :: [ConcurrentSupplyLabelGen] -> ShowS
Show )

makeLenses ''ConcurrentSupplyLabelGen

mkConcurrentSupplyLabelGen :: MonadIO m => m LabelGen
mkConcurrentSupplyLabelGen :: forall (m :: * -> *). MonadIO m => m LabelGen
mkConcurrentSupplyLabelGen = do Supply
s <- IO Supply -> m Supply
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Supply
newSupply
                                return $ ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen -> LabelGen)
-> ConcurrentSupplyLabelGen -> LabelGen
forall a b. (a -> b) -> a -> b
$ ConcurrentSupplyLabelGen { _supply :: Supply
_supply = Supply
s }

runConcurrentSupplyLabeler :: (MonadIO m) => StateT LabelGen m a -> m a
runConcurrentSupplyLabeler :: forall (m :: * -> *) a. MonadIO m => StateT LabelGen m a -> m a
runConcurrentSupplyLabeler StateT LabelGen m a
m = do LabelGen
s <- m LabelGen
forall (m :: * -> *). MonadIO m => m LabelGen
mkConcurrentSupplyLabelGen
                                  StateT LabelGen m a -> LabelGen -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT LabelGen m a
m LabelGen
s

unsafeMkConcurrentSupplyLabelGen :: () -> LabelGen
unsafeMkConcurrentSupplyLabelGen :: () -> LabelGen
unsafeMkConcurrentSupplyLabelGen () = IO LabelGen -> LabelGen
forall a. IO a -> a
unsafePerformIO IO LabelGen
forall (m :: * -> *). MonadIO m => m LabelGen
mkConcurrentSupplyLabelGen
{-# NOINLINE unsafeMkConcurrentSupplyLabelGen #-}

debugMakeLabel :: Int -> Label
debugMakeLabel :: Int -> Label
debugMakeLabel = Int -> Label
Label

instance LabelGenInterface ConcurrentSupplyLabelGen where
  genLabel :: ConcurrentSupplyLabelGen -> (Label, LabelGen)
genLabel ConcurrentSupplyLabelGen
g = ( Int -> Label
Label Int
l
               , ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s)
               )
    where
      (Int
l, Supply
s) = Supply -> (Int, Supply)
freshId (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> Getting Supply ConcurrentSupplyLabelGen Supply -> Supply
forall s a. s -> Getting a s a -> a
^. Getting Supply ConcurrentSupplyLabelGen Supply
Iso' ConcurrentSupplyLabelGen Supply
supply)

  split :: ConcurrentSupplyLabelGen -> (LabelGen, LabelGen)
split ConcurrentSupplyLabelGen
g = ( ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s)
            , ConcurrentSupplyLabelGen -> LabelGen
forall a. LabelGenInterface a => a -> LabelGen
LabelGen (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> (ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen)
-> ConcurrentSupplyLabelGen
forall a b. a -> (a -> b) -> b
& (Supply -> Identity Supply)
-> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen
Iso' ConcurrentSupplyLabelGen Supply
supply ((Supply -> Identity Supply)
 -> ConcurrentSupplyLabelGen -> Identity ConcurrentSupplyLabelGen)
-> Supply -> ConcurrentSupplyLabelGen -> ConcurrentSupplyLabelGen
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Supply
s')
            )
    where
      (Supply
s,Supply
s') = Supply -> (Supply, Supply)
splitSupply (ConcurrentSupplyLabelGen
g ConcurrentSupplyLabelGen
-> Getting Supply ConcurrentSupplyLabelGen Supply -> Supply
forall s a. s -> Getting a s a -> a
^. Getting Supply ConcurrentSupplyLabelGen Supply
Iso' ConcurrentSupplyLabelGen Supply
supply)

--------------------------------------------------------------------------------

labelToAttrs :: (f :&: Label) e l -> (f :&: Attrs) e l
labelToAttrs :: forall (f :: Node) (e :: * -> *) l.
(:&:) f Label e l -> (:&:) f Attrs e l
labelToAttrs (f e l
x :&: Label
l) = f e l
x f e l -> Attrs -> (:&:) f Attrs e l
forall (f :: Node) a (g :: * -> *) e. f g e -> a -> (:&:) f a g e
:&: Label -> Maybe SourceSpan -> Attrs
Attrs Label
l Maybe SourceSpan
forall a. Maybe a
Nothing


-- | Fully annotates a term with fresh labels
annotateLabel :: (HTraversable f, MonadAnnotater Label m) => CxtFunM m f (f :&: Label)
annotateLabel :: forall (f :: Node) (m :: * -> *).
(HTraversable f, MonadAnnotater Label m) =>
CxtFunM m f (f :&: Label)
annotateLabel = Cxt h f a i -> m (Cxt h (f :&: Label) a i)
CxtFunM m f (f :&: Label)
forall (f :: Node) a (m :: * -> *).
(HTraversable f, MonadAnnotater a m) =>
CxtFunM m f (f :&: a)
annotateM

annotateLabelOuter :: (HTraversable f, MonadAnnotater Label m) => Context f (HFixLab f) l -> m (HFixLab f l)
annotateLabelOuter :: forall (f :: Node) (m :: * -> *) l.
(HTraversable f, MonadAnnotater Label m) =>
Context f (HFixLab f) l -> m (HFixLab f l)
annotateLabelOuter = Context f (AnnHFix Label f) l -> m (AnnHFix Label f l)
forall (f :: Node) a (m :: * -> *) l.
(HTraversable f, MonadAnnotater a m) =>
Context f (AnnHFix a f) l -> m (AnnHFix a f l)
annotateOuter

labelProg' :: (HTraversable f) => LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' :: forall (f :: Node) l.
HTraversable f =>
LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' LabelGen
gen HFix f l
t = State LabelGen (HFixLab f l) -> LabelGen -> (HFixLab f l, LabelGen)
forall s a. State s a -> s -> (a, s)
runState (HFix f l -> State LabelGen (HFixLab f l)
CxtFunM (StateT LabelGen Identity) f (f :&: Label)
forall (f :: Node) (m :: * -> *).
(HTraversable f, MonadAnnotater Label m) =>
CxtFunM m f (f :&: Label)
annotateLabel HFix f l
t) LabelGen
gen

labelProg :: (HTraversable f) => LabelGen -> HFix f l -> HFixLab f l
labelProg :: forall (f :: Node) l.
HTraversable f =>
LabelGen -> HFix f l -> HFixLab f l
labelProg LabelGen
gen HFix f l
t = (HFixLab f l, LabelGen) -> HFixLab f l
forall a b. (a, b) -> a
fst ((HFixLab f l, LabelGen) -> HFixLab f l)
-> (HFixLab f l, LabelGen) -> HFixLab f l
forall a b. (a -> b) -> a -> b
$ LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
forall (f :: Node) l.
HTraversable f =>
LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' LabelGen
gen HFix f l
t

annotateTop :: (MonadAnnotater Label m) => f (HFixLab f) l -> m (HFixLab f l)
annotateTop :: forall (m :: * -> *) (f :: Node) l.
MonadAnnotater Label m =>
f (HFixLab f) l -> m (HFixLab f l)
annotateTop = ((:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l -> HFixLab f l)
-> m ((:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l)
-> m (HFixLab f l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l -> HFixLab f l
forall (f :: Node) h (a :: * -> *) i.
f (Cxt h f a) i -> Cxt h f a i
Term (m ((:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l)
 -> m (HFixLab f l))
-> (f (Cxt NoHole (f :&: Label) (K ())) l
    -> m ((:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l))
-> f (Cxt NoHole (f :&: Label) (K ())) l
-> m (HFixLab f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Cxt NoHole (f :&: Label) (K ())) l
-> m ((:&:) f Label (Cxt NoHole (f :&: Label) (K ())) l)
forall a (m :: * -> *) (f :: Node) (e :: * -> *) l.
MonadAnnotater a m =>
f e l -> m ((:&:) f a e l)
forall (f :: Node) (e :: * -> *) l. f e l -> m ((:&:) f Label e l)
annM

annotateTop' :: (f :<: g, MonadAnnotater Label m) => f (HFixLab g) l -> m (HFixLab g l)
annotateTop' :: forall (f :: Node) (g :: Node) (m :: * -> *) l.
(f :<: g, MonadAnnotater Label m) =>
f (HFixLab g) l -> m (HFixLab g l)
annotateTop' = g (HFixLab g) l -> m (HFixLab g l)
forall (m :: * -> *) (f :: Node) l.
MonadAnnotater Label m =>
f (HFixLab f) l -> m (HFixLab f l)
annotateTop (g (HFixLab g) l -> m (HFixLab g l))
-> (f (HFixLab g) l -> g (HFixLab g) l)
-> f (HFixLab g) l
-> m (HFixLab g l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixLab g) l -> g (HFixLab g) l
forall (a :: * -> *). f a :-> g a
forall (f :: Node) (g :: Node) (a :: * -> *).
(f :<: g) =>
f a :-> g a
inj

annotateTopAttrs :: (MonadAnnotater Label m) => f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs :: forall (m :: * -> *) (f :: Node) l.
MonadAnnotater Label m =>
f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs = ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l
 -> HFixAttrs f l)
-> m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l)
-> m (HFixAttrs f l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l -> HFixAttrs f l
forall (f :: Node) h (a :: * -> *) i.
f (Cxt h f a) i -> Cxt h f a i
Term (m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l)
 -> m (HFixAttrs f l))
-> (f (Cxt NoHole (f :&: Attrs) (K ())) l
    -> m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l))
-> f (Cxt NoHole (f :&: Attrs) (K ())) l
-> m (HFixAttrs f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l
 -> (:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l)
-> m ((:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l)
-> m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l
-> (:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l
forall (f :: Node) (e :: * -> *) l.
(:&:) f Label e l -> (:&:) f Attrs e l
labelToAttrs (m ((:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l)
 -> m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l))
-> (f (Cxt NoHole (f :&: Attrs) (K ())) l
    -> m ((:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l))
-> f (Cxt NoHole (f :&: Attrs) (K ())) l
-> m ((:&:) f Attrs (Cxt NoHole (f :&: Attrs) (K ())) l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Cxt NoHole (f :&: Attrs) (K ())) l
-> m ((:&:) f Label (Cxt NoHole (f :&: Attrs) (K ())) l)
forall a (m :: * -> *) (f :: Node) (e :: * -> *) l.
MonadAnnotater a m =>
f e l -> m ((:&:) f a e l)
forall (f :: Node) (e :: * -> *) l. f e l -> m ((:&:) f Label e l)
annM

annotateTopAttrs' :: (f :<: g, MonadAnnotater Label m) => f (HFixAttrs g) l -> m (HFixAttrs g l)
annotateTopAttrs' :: forall (f :: Node) (g :: Node) (m :: * -> *) l.
(f :<: g, MonadAnnotater Label m) =>
f (HFixAttrs g) l -> m (HFixAttrs g l)
annotateTopAttrs' = g (HFixAttrs g) l -> m (HFixAttrs g l)
forall (m :: * -> *) (f :: Node) l.
MonadAnnotater Label m =>
f (HFixAttrs f) l -> m (HFixAttrs f l)
annotateTopAttrs (g (HFixAttrs g) l -> m (HFixAttrs g l))
-> (f (HFixAttrs g) l -> g (HFixAttrs g) l)
-> f (HFixAttrs g) l
-> m (HFixAttrs g l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (HFixAttrs g) l -> g (HFixAttrs g) l
forall (a :: * -> *). f a :-> g a
forall (f :: Node) (g :: Node) (a :: * -> *).
(f :<: g) =>
f a :-> g a
inj

--------------------------------------------------------------------------------

type Project fs = Map FilePath (E (TermLab fs))

parseProject ::
  forall fs l.
  ( All HFoldable fs
  , All HFunctor fs
  , All HTraversable fs
  ) => LabelGen -> (FilePath -> IO (Maybe (Term fs l))) -> [FilePath] -> IO (Maybe (Project fs))
parseProject :: forall (fs :: [Node]) l.
(All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen
-> (String -> IO (Maybe (Term fs l)))
-> [String]
-> IO (Maybe (Project fs))
parseProject LabelGen
gen String -> IO (Maybe (Term fs l))
parse [String]
fils = MaybeT IO (Project fs) -> IO (Maybe (Project fs))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT ((All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen -> [String] -> MaybeT IO (Project fs)
LabelGen -> [String] -> MaybeT IO (Project fs)
go LabelGen
gen [String]
fils)
  where
    go :: (All HFoldable fs, All HFunctor fs, All HTraversable fs) => LabelGen -> [FilePath] -> MaybeT IO (Project fs)
    go :: (All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen -> [String] -> MaybeT IO (Project fs)
go LabelGen
gen []         = Project fs -> MaybeT IO (Project fs)
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Project fs
forall k a. Map k a
Map.empty
    go LabelGen
gen (String
fil:[String]
fils) = do Term fs l
t <- IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l))
-> IO (Maybe (Term fs l)) -> MaybeT IO (Term fs l)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Term fs l))
parse String
fil
                           let (HFixLab (Sum fs) l
tLab, LabelGen
gen') = LabelGen -> Term fs l -> (HFixLab (Sum fs) l, LabelGen)
forall (f :: Node) l.
HTraversable f =>
LabelGen -> HFix f l -> (HFixLab f l, LabelGen)
labelProg' LabelGen
gen Term fs l
t
                           Project fs
prj <- (All HFoldable fs, All HFunctor fs, All HTraversable fs) =>
LabelGen -> [String] -> MaybeT IO (Project fs)
LabelGen -> [String] -> MaybeT IO (Project fs)
go LabelGen
gen' [String]
fils
                           return $ String -> E (TermLab fs) -> Project fs -> Project fs
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
fil (HFixLab (Sum fs) l -> E (TermLab fs)
forall (f :: * -> *) i. f i -> E f
E HFixLab (Sum fs) l
tLab) Project fs
prj

rewriteProjectM :: (Applicative m) => (forall l. TermLab fs l -> m (TermLab fs l)) -> Project fs -> m (Project fs)
rewriteProjectM :: forall (m :: * -> *) (fs :: [Node]).
Applicative m =>
(forall l. TermLab fs l -> m (TermLab fs l))
-> Project fs -> m (Project fs)
rewriteProjectM forall l. TermLab fs l -> m (TermLab fs l)
f = (E (TermLab fs) -> m (E (TermLab fs)))
-> Map String (E (TermLab fs)) -> m (Map String (E (TermLab fs)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map String a -> f (Map String b)
traverse ((forall l. TermLab fs l -> m (TermLab fs l))
-> E (TermLab fs) -> m (E (TermLab fs))
forall (m :: * -> *) (f :: * -> *).
Functor m =>
(forall l. f l -> m (f l)) -> E f -> m (E f)
rewriteEM TermLab fs l -> m (TermLab fs l)
forall l. TermLab fs l -> m (TermLab fs l)
f)

rewriteProjectWithFilM :: (Applicative m) => (forall l. FilePath -> TermLab fs l -> m (TermLab fs l)) -> Project fs -> m (Project fs)
rewriteProjectWithFilM :: forall (m :: * -> *) (fs :: [Node]).
Applicative m =>
(forall l. String -> TermLab fs l -> m (TermLab fs l))
-> Project fs -> m (Project fs)
rewriteProjectWithFilM forall l. String -> TermLab fs l -> m (TermLab fs l)
f = (String -> E (TermLab fs) -> m (E (TermLab fs)))
-> Map String (E (TermLab fs)) -> m (Map String (E (TermLab fs)))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\String
k E (TermLab fs)
t -> (forall l. TermLab fs l -> m (TermLab fs l))
-> E (TermLab fs) -> m (E (TermLab fs))
forall (m :: * -> *) (f :: * -> *).
Functor m =>
(forall l. f l -> m (f l)) -> E f -> m (E f)
rewriteEM (String -> TermLab fs l -> m (TermLab fs l)
forall l. String -> TermLab fs l -> m (TermLab fs l)
f String
k) E (TermLab fs)
t)

putProject :: (forall l. TermLab fs l -> String) -> Project fs -> IO ()
putProject :: forall (fs :: [Node]).
(forall l. TermLab fs l -> String) -> Project fs -> IO ()
putProject forall l. TermLab fs l -> String
pp Project fs
prj = [(String, E (TermLab fs))]
-> ((String, E (TermLab fs)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Project fs -> [(String, E (TermLab fs))]
forall k a. Map k a -> [(k, a)]
Map.toList Project fs
prj) (\(String
fil, E TermLab fs i
t) -> String -> String -> IO ()
writeFile String
fil (TermLab fs i -> String
forall l. TermLab fs l -> String
pp TermLab fs i
t))