module Data.Singletons.TH.Options
(
Options, defaultOptions
, genQuotedDecs
, genSingKindInsts
, promotedDataTypeOrConName
, promotedClassName
, promotedValueName
, singledDataTypeName
, singledClassName
, singledDataConName
, singledValueName
, defunctionalizedName
, promotedTopLevelValueName
, promotedLetBoundValueName
, defunctionalizedName0
, OptionsMonad(..), OptionsM, withOptions
) where
import Control.Applicative
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT(..), ask)
import Control.Monad.RWS (RWST)
import Control.Monad.State (StateT)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Writer (WriterT)
import Data.Singletons.TH.Names
import Data.Singletons.TH.Util
import Language.Haskell.TH.Desugar
import Language.Haskell.TH.Instances ()
import Language.Haskell.TH.Syntax hiding (Lift(..))
data Options = Options
{ Options -> Bool
genQuotedDecs :: Bool
, Options -> Bool
genSingKindInsts :: Bool
, Options -> Name -> Name
promotedDataTypeOrConName :: Name -> Name
, Options -> Name -> Name
promotedClassName :: Name -> Name
, Options -> Name -> Maybe Uniq -> Name
promotedValueName :: Name -> Maybe Uniq -> Name
, Options -> Name -> Name
singledDataTypeName :: Name -> Name
, Options -> Name -> Name
singledClassName :: Name -> Name
, Options -> Name -> Name
singledDataConName :: Name -> Name
, Options -> Name -> Name
singledValueName :: Name -> Name
, Options -> Name -> Int -> Name
defunctionalizedName :: Name -> Int -> Name
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
{ genQuotedDecs :: Bool
genQuotedDecs = Bool
True
, genSingKindInsts :: Bool
genSingKindInsts = Bool
True
, promotedDataTypeOrConName :: Name -> Name
promotedDataTypeOrConName = Name -> Name
promoteDataTypeOrConName
, promotedClassName :: Name -> Name
promotedClassName = Name -> Name
promoteClassName
, promotedValueName :: Name -> Maybe Uniq -> Name
promotedValueName = Name -> Maybe Uniq -> Name
promoteValNameLhs
, singledDataTypeName :: Name -> Name
singledDataTypeName = Name -> Name
singTyConName
, singledClassName :: Name -> Name
singledClassName = Name -> Name
singClassName
, singledDataConName :: Name -> Name
singledDataConName = Name -> Name
singDataConName
, singledValueName :: Name -> Name
singledValueName = Name -> Name
singValName
, defunctionalizedName :: Name -> Int -> Name
defunctionalizedName = Name -> Int -> Name
promoteTySym
}
promotedTopLevelValueName :: Options -> Name -> Name
promotedTopLevelValueName :: Options -> Name -> Name
promotedTopLevelValueName Options
opts Name
name = Options -> Name -> Maybe Uniq -> Name
promotedValueName Options
opts Name
name Maybe Uniq
forall a. Maybe a
Nothing
promotedLetBoundValueName :: Options -> Name -> Uniq -> Name
promotedLetBoundValueName :: Options -> Name -> Uniq -> Name
promotedLetBoundValueName Options
opts Name
name = Options -> Name -> Maybe Uniq -> Name
promotedValueName Options
opts Name
name (Maybe Uniq -> Name) -> (Uniq -> Maybe Uniq) -> Uniq -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniq -> Maybe Uniq
forall a. a -> Maybe a
Just
defunctionalizedName0 :: Options -> Name -> Name
defunctionalizedName0 :: Options -> Name -> Name
defunctionalizedName0 Options
opts Name
name = Options -> Name -> Int -> Name
defunctionalizedName Options
opts Name
name Int
0
class DsMonad m => OptionsMonad m where
getOptions :: m Options
instance OptionsMonad Q where
getOptions :: Q Options
getOptions = Options -> Q Options
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Options
defaultOptions
instance OptionsMonad m => OptionsMonad (DsM m) where
getOptions :: DsM m Options
getOptions = m Options -> DsM m Options
forall (m :: * -> *) a. Monad m => m a -> DsM m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
instance (OptionsMonad q, Monoid m) => OptionsMonad (QWithAux m q) where
getOptions :: QWithAux m q Options
getOptions = q Options -> QWithAux m q Options
forall (m :: * -> *) a. Monad m => m a -> QWithAux m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift q Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
instance OptionsMonad m => OptionsMonad (ReaderT r m) where
getOptions :: ReaderT r m Options
getOptions = m Options -> ReaderT r m Options
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
instance OptionsMonad m => OptionsMonad (StateT s m) where
getOptions :: StateT s m Options
getOptions = m Options -> StateT s m Options
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
instance (OptionsMonad m, Monoid w) => OptionsMonad (WriterT w m) where
getOptions :: WriterT w m Options
getOptions = m Options -> WriterT w m Options
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
instance (OptionsMonad m, Monoid w) => OptionsMonad (RWST r w s m) where
getOptions :: RWST r w s m Options
getOptions = m Options -> RWST r w s m Options
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Options
forall (m :: * -> *). OptionsMonad m => m Options
getOptions
newtype OptionsM m a = OptionsM (ReaderT Options m a)
deriving ( (forall a b. (a -> b) -> OptionsM m a -> OptionsM m b)
-> (forall a b. a -> OptionsM m b -> OptionsM m a)
-> Functor (OptionsM m)
forall a b. a -> OptionsM m b -> OptionsM m a
forall a b. (a -> b) -> OptionsM m a -> OptionsM m b
forall (m :: * -> *) a b.
Functor m =>
a -> OptionsM m b -> OptionsM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OptionsM m a -> OptionsM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OptionsM m a -> OptionsM m b
fmap :: forall a b. (a -> b) -> OptionsM m a -> OptionsM m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> OptionsM m b -> OptionsM m a
<$ :: forall a b. a -> OptionsM m b -> OptionsM m a
Functor, Functor (OptionsM m)
Functor (OptionsM m) =>
(forall a. a -> OptionsM m a)
-> (forall a b.
OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b)
-> (forall a b c.
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c)
-> (forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b)
-> (forall a b. OptionsM m a -> OptionsM m b -> OptionsM m a)
-> Applicative (OptionsM m)
forall a. a -> OptionsM m a
forall a b. OptionsM m a -> OptionsM m b -> OptionsM m a
forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b
forall a b. OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
forall a b c.
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (OptionsM m)
forall (m :: * -> *) a. Applicative m => a -> OptionsM m a
forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m a
forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
forall (m :: * -> *) a b.
Applicative m =>
OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> OptionsM m a
pure :: forall a. a -> OptionsM m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
<*> :: forall a b. OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
liftA2 :: forall a b c.
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
*> :: forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m a
<* :: forall a b. OptionsM m a -> OptionsM m b -> OptionsM m a
Applicative, Applicative (OptionsM m)
Applicative (OptionsM m) =>
(forall a b. OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b)
-> (forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b)
-> (forall a. a -> OptionsM m a)
-> Monad (OptionsM m)
forall a. a -> OptionsM m a
forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b
forall a b. OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
forall (m :: * -> *). Monad m => Applicative (OptionsM m)
forall (m :: * -> *) a. Monad m => a -> OptionsM m a
forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
>>= :: forall a b. OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
>> :: forall a b. OptionsM m a -> OptionsM m b -> OptionsM m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> OptionsM m a
return :: forall a. a -> OptionsM m a
Monad, (forall (m :: * -> *). Monad m => Monad (OptionsM m)) =>
(forall (m :: * -> *) a. Monad m => m a -> OptionsM m a)
-> MonadTrans OptionsM
forall (m :: * -> *). Monad m => Monad (OptionsM m)
forall (m :: * -> *) a. Monad m => m a -> OptionsM m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> OptionsM m a
lift :: forall (m :: * -> *) a. Monad m => m a -> OptionsM m a
MonadTrans
, Monad (OptionsM m)
Monad (OptionsM m) =>
(String -> OptionsM m Name) -> Quote (OptionsM m)
String -> OptionsM m Name
forall (m :: * -> *). Monad m => (String -> m Name) -> Quote m
forall (m :: * -> *). Quote m => Monad (OptionsM m)
forall (m :: * -> *). Quote m => String -> OptionsM m Name
$cnewName :: forall (m :: * -> *). Quote m => String -> OptionsM m Name
newName :: String -> OptionsM m Name
Quote, MonadFail (OptionsM m)
MonadIO (OptionsM m)
OptionsM m String
OptionsM m [Extension]
OptionsM m Loc
Bool -> String -> OptionsM m (Maybe Name)
Bool -> String -> OptionsM m ()
String -> OptionsM m String
String -> OptionsM m Name
String -> OptionsM m ()
[Dec] -> OptionsM m ()
Q () -> OptionsM m ()
Name -> OptionsM m [Role]
Name -> OptionsM m [DecidedStrictness]
Name -> OptionsM m (Maybe Fixity)
Name -> OptionsM m Type
Name -> OptionsM m Info
Name -> [Type] -> OptionsM m [Dec]
(MonadIO (OptionsM m), MonadFail (OptionsM m)) =>
(String -> OptionsM m Name)
-> (Bool -> String -> OptionsM m ())
-> (forall a. OptionsM m a -> OptionsM m a -> OptionsM m a)
-> (Bool -> String -> OptionsM m (Maybe Name))
-> (Name -> OptionsM m Info)
-> (Name -> OptionsM m (Maybe Fixity))
-> (Name -> OptionsM m Type)
-> (Name -> [Type] -> OptionsM m [Dec])
-> (Name -> OptionsM m [Role])
-> (forall a. Data a => AnnLookup -> OptionsM m [a])
-> (Module -> OptionsM m ModuleInfo)
-> (Name -> OptionsM m [DecidedStrictness])
-> OptionsM m Loc
-> (forall a. IO a -> OptionsM m a)
-> OptionsM m String
-> (String -> OptionsM m ())
-> (String -> OptionsM m String)
-> ([Dec] -> OptionsM m ())
-> (ForeignSrcLang -> String -> OptionsM m ())
-> (Q () -> OptionsM m ())
-> (String -> OptionsM m ())
-> (forall a. Typeable a => OptionsM m (Maybe a))
-> (forall a. Typeable a => a -> OptionsM m ())
-> (Extension -> OptionsM m Bool)
-> OptionsM m [Extension]
-> (DocLoc -> String -> OptionsM m ())
-> (DocLoc -> OptionsM m (Maybe String))
-> Quasi (OptionsM m)
ForeignSrcLang -> String -> OptionsM m ()
Extension -> OptionsM m Bool
DocLoc -> OptionsM m (Maybe String)
DocLoc -> String -> OptionsM m ()
Module -> OptionsM m ModuleInfo
forall a. Data a => AnnLookup -> OptionsM m [a]
forall a. Typeable a => OptionsM m (Maybe a)
forall a. Typeable a => a -> OptionsM m ()
forall a. IO a -> OptionsM m a
forall a. OptionsM m a -> OptionsM m a -> OptionsM m a
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
(String -> m Name)
-> (Bool -> String -> m ())
-> (forall a. m a -> m a -> m a)
-> (Bool -> String -> m (Maybe Name))
-> (Name -> m Info)
-> (Name -> m (Maybe Fixity))
-> (Name -> m Type)
-> (Name -> [Type] -> m [Dec])
-> (Name -> m [Role])
-> (forall a. Data a => AnnLookup -> m [a])
-> (Module -> m ModuleInfo)
-> (Name -> m [DecidedStrictness])
-> m Loc
-> (forall a. IO a -> m a)
-> m String
-> (String -> m ())
-> (String -> m String)
-> ([Dec] -> m ())
-> (ForeignSrcLang -> String -> m ())
-> (Q () -> m ())
-> (String -> m ())
-> (forall a. Typeable a => m (Maybe a))
-> (forall a. Typeable a => a -> m ())
-> (Extension -> m Bool)
-> m [Extension]
-> (DocLoc -> String -> m ())
-> (DocLoc -> m (Maybe String))
-> Quasi m
forall (m :: * -> *). Quasi m => MonadFail (OptionsM m)
forall (m :: * -> *). Quasi m => MonadIO (OptionsM m)
forall (m :: * -> *). Quasi m => OptionsM m String
forall (m :: * -> *). Quasi m => OptionsM m [Extension]
forall (m :: * -> *). Quasi m => OptionsM m Loc
forall (m :: * -> *).
Quasi m =>
Bool -> String -> OptionsM m (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> String -> OptionsM m ()
forall (m :: * -> *). Quasi m => String -> OptionsM m String
forall (m :: * -> *). Quasi m => String -> OptionsM m Name
forall (m :: * -> *). Quasi m => String -> OptionsM m ()
forall (m :: * -> *). Quasi m => [Dec] -> OptionsM m ()
forall (m :: * -> *). Quasi m => Q () -> OptionsM m ()
forall (m :: * -> *). Quasi m => Name -> OptionsM m [Role]
forall (m :: * -> *).
Quasi m =>
Name -> OptionsM m [DecidedStrictness]
forall (m :: * -> *). Quasi m => Name -> OptionsM m (Maybe Fixity)
forall (m :: * -> *). Quasi m => Name -> OptionsM m Type
forall (m :: * -> *). Quasi m => Name -> OptionsM m Info
forall (m :: * -> *). Quasi m => Name -> [Type] -> OptionsM m [Dec]
forall (m :: * -> *).
Quasi m =>
ForeignSrcLang -> String -> OptionsM m ()
forall (m :: * -> *). Quasi m => Extension -> OptionsM m Bool
forall (m :: * -> *).
Quasi m =>
DocLoc -> OptionsM m (Maybe String)
forall (m :: * -> *). Quasi m => DocLoc -> String -> OptionsM m ()
forall (m :: * -> *). Quasi m => Module -> OptionsM m ModuleInfo
forall (m :: * -> *) a.
(Quasi m, Data a) =>
AnnLookup -> OptionsM m [a]
forall (m :: * -> *) a.
(Quasi m, Typeable a) =>
OptionsM m (Maybe a)
forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> OptionsM m ()
forall (m :: * -> *) a. Quasi m => IO a -> OptionsM m a
forall (m :: * -> *) a.
Quasi m =>
OptionsM m a -> OptionsM m a -> OptionsM m a
$cqNewName :: forall (m :: * -> *). Quasi m => String -> OptionsM m Name
qNewName :: String -> OptionsM m Name
$cqReport :: forall (m :: * -> *). Quasi m => Bool -> String -> OptionsM m ()
qReport :: Bool -> String -> OptionsM m ()
$cqRecover :: forall (m :: * -> *) a.
Quasi m =>
OptionsM m a -> OptionsM m a -> OptionsM m a
qRecover :: forall a. OptionsM m a -> OptionsM m a -> OptionsM m a
$cqLookupName :: forall (m :: * -> *).
Quasi m =>
Bool -> String -> OptionsM m (Maybe Name)
qLookupName :: Bool -> String -> OptionsM m (Maybe Name)
$cqReify :: forall (m :: * -> *). Quasi m => Name -> OptionsM m Info
qReify :: Name -> OptionsM m Info
$cqReifyFixity :: forall (m :: * -> *). Quasi m => Name -> OptionsM m (Maybe Fixity)
qReifyFixity :: Name -> OptionsM m (Maybe Fixity)
$cqReifyType :: forall (m :: * -> *). Quasi m => Name -> OptionsM m Type
qReifyType :: Name -> OptionsM m Type
$cqReifyInstances :: forall (m :: * -> *). Quasi m => Name -> [Type] -> OptionsM m [Dec]
qReifyInstances :: Name -> [Type] -> OptionsM m [Dec]
$cqReifyRoles :: forall (m :: * -> *). Quasi m => Name -> OptionsM m [Role]
qReifyRoles :: Name -> OptionsM m [Role]
$cqReifyAnnotations :: forall (m :: * -> *) a.
(Quasi m, Data a) =>
AnnLookup -> OptionsM m [a]
qReifyAnnotations :: forall a. Data a => AnnLookup -> OptionsM m [a]
$cqReifyModule :: forall (m :: * -> *). Quasi m => Module -> OptionsM m ModuleInfo
qReifyModule :: Module -> OptionsM m ModuleInfo
$cqReifyConStrictness :: forall (m :: * -> *).
Quasi m =>
Name -> OptionsM m [DecidedStrictness]
qReifyConStrictness :: Name -> OptionsM m [DecidedStrictness]
$cqLocation :: forall (m :: * -> *). Quasi m => OptionsM m Loc
qLocation :: OptionsM m Loc
$cqRunIO :: forall (m :: * -> *) a. Quasi m => IO a -> OptionsM m a
qRunIO :: forall a. IO a -> OptionsM m a
$cqGetPackageRoot :: forall (m :: * -> *). Quasi m => OptionsM m String
qGetPackageRoot :: OptionsM m String
$cqAddDependentFile :: forall (m :: * -> *). Quasi m => String -> OptionsM m ()
qAddDependentFile :: String -> OptionsM m ()
$cqAddTempFile :: forall (m :: * -> *). Quasi m => String -> OptionsM m String
qAddTempFile :: String -> OptionsM m String
$cqAddTopDecls :: forall (m :: * -> *). Quasi m => [Dec] -> OptionsM m ()
qAddTopDecls :: [Dec] -> OptionsM m ()
$cqAddForeignFilePath :: forall (m :: * -> *).
Quasi m =>
ForeignSrcLang -> String -> OptionsM m ()
qAddForeignFilePath :: ForeignSrcLang -> String -> OptionsM m ()
$cqAddModFinalizer :: forall (m :: * -> *). Quasi m => Q () -> OptionsM m ()
qAddModFinalizer :: Q () -> OptionsM m ()
$cqAddCorePlugin :: forall (m :: * -> *). Quasi m => String -> OptionsM m ()
qAddCorePlugin :: String -> OptionsM m ()
$cqGetQ :: forall (m :: * -> *) a.
(Quasi m, Typeable a) =>
OptionsM m (Maybe a)
qGetQ :: forall a. Typeable a => OptionsM m (Maybe a)
$cqPutQ :: forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> OptionsM m ()
qPutQ :: forall a. Typeable a => a -> OptionsM m ()
$cqIsExtEnabled :: forall (m :: * -> *). Quasi m => Extension -> OptionsM m Bool
qIsExtEnabled :: Extension -> OptionsM m Bool
$cqExtsEnabled :: forall (m :: * -> *). Quasi m => OptionsM m [Extension]
qExtsEnabled :: OptionsM m [Extension]
$cqPutDoc :: forall (m :: * -> *). Quasi m => DocLoc -> String -> OptionsM m ()
qPutDoc :: DocLoc -> String -> OptionsM m ()
$cqGetDoc :: forall (m :: * -> *).
Quasi m =>
DocLoc -> OptionsM m (Maybe String)
qGetDoc :: DocLoc -> OptionsM m (Maybe String)
Quasi, Monad (OptionsM m)
Monad (OptionsM m) =>
(forall a. String -> OptionsM m a) -> MonadFail (OptionsM m)
forall a. String -> OptionsM m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (OptionsM m)
forall (m :: * -> *) a. MonadFail m => String -> OptionsM m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> OptionsM m a
fail :: forall a. String -> OptionsM m a
MonadFail, Monad (OptionsM m)
Monad (OptionsM m) =>
(forall a. IO a -> OptionsM m a) -> MonadIO (OptionsM m)
forall a. IO a -> OptionsM m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (OptionsM m)
forall (m :: * -> *) a. MonadIO m => IO a -> OptionsM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> OptionsM m a
liftIO :: forall a. IO a -> OptionsM m a
MonadIO, MonadFail (OptionsM m)
Quasi (OptionsM m)
OptionsM m [Dec]
(Quasi (OptionsM m), MonadFail (OptionsM m)) =>
OptionsM m [Dec] -> DsMonad (OptionsM m)
forall (m :: * -> *).
(Quasi m, MonadFail m) =>
m [Dec] -> DsMonad m
forall (m :: * -> *). DsMonad m => MonadFail (OptionsM m)
forall (m :: * -> *). DsMonad m => Quasi (OptionsM m)
forall (m :: * -> *). DsMonad m => OptionsM m [Dec]
$clocalDeclarations :: forall (m :: * -> *). DsMonad m => OptionsM m [Dec]
localDeclarations :: OptionsM m [Dec]
DsMonad )
instance DsMonad m => OptionsMonad (OptionsM m) where
getOptions :: OptionsM m Options
getOptions = ReaderT Options m Options -> OptionsM m Options
forall (m :: * -> *) a. ReaderT Options m a -> OptionsM m a
OptionsM ReaderT Options m Options
forall r (m :: * -> *). MonadReader r m => m r
ask
withOptions :: Options -> OptionsM m a -> m a
withOptions :: forall (m :: * -> *) a. Options -> OptionsM m a -> m a
withOptions Options
opts (OptionsM ReaderT Options m a
x) = ReaderT Options m a -> Options -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Options m a
x Options
opts
promoteValNameLhs :: Name -> Maybe Uniq -> Name
promoteValNameLhs :: Name -> Maybe Uniq -> Name
promoteValNameLhs Name
n Maybe Uniq
mb_let_uniq
| Just (String
us, String
rest) <- String -> Maybe (String, String)
splitUnderscores (Name -> String
nameBase Name
n)
= String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
alpha String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"US" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
us String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest
| Bool
otherwise
= String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (String, String) -> Name -> String
toUpcaseStr (String, String)
pres Name
n
where
pres :: (String, String)
pres = (String, String)
-> (Uniq -> (String, String)) -> Maybe Uniq -> (String, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String, String)
noPrefix (String -> String -> Uniq -> (String, String)
uniquePrefixes String
"Let" String
"<<<") Maybe Uniq
mb_let_uniq
(String
alpha, String
_) = (String, String)
pres
promoteTySym :: Name -> Int -> Name
promoteTySym :: Name -> Int -> Name
promoteTySym Name
name Int
sat
| Just (String
us, String
rest) <- String -> Maybe (String, String)
splitUnderscores (Name -> String
nameBase Name
name)
= Name -> Name
default_case (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"US" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
us String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest)
| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nilName
= String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"NilSym" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
sat)
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
name Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
name
= String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"Tuple" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
degree String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Sym" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sat
| Bool
otherwise
= Name -> Name
default_case Name
name
where
default_case :: Name -> Name
default_case :: Name -> Name
default_case Name
name' =
let capped :: String
capped = (String, String) -> Name -> String
toUpcaseStr (String, String)
noPrefix Name
name' in
if Char -> Bool
isHsLetter (String -> Char
forall a. HasCallStack => [a] -> a
head String
capped)
then String -> Name
mkName (String
capped String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Sym" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
sat))
else String -> Name
mkName (String
capped String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"@#@"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
sat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'$'))
promoteClassName :: Name -> Name
promoteClassName :: Name -> Name
promoteClassName = String -> String -> Name -> Name
prefixName String
"P" String
"#"
promoteDataTypeOrConName :: Name -> Name
promoteDataTypeOrConName :: Name -> Name
promoteDataTypeOrConName Name
nm
| Name -> String
nameBase Name
nm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> String
nameBase Name
repName = Name
typeKindName
| Just Int
degree <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
nm
= if Name -> Bool
isDataName Name
nm then Int -> Name
tupleDataName Int
degree else Int -> Name
tupleTypeName Int
degree
| Bool
otherwise = Name
nm
where
isDataName :: Name -> Bool
isDataName :: Name -> Bool
isDataName (Name OccName
_ (NameG NameSpace
DataName PkgName
_ ModName
_)) = Bool
True
isDataName Name
_ = Bool
False
singDataConName :: Name -> Name
singDataConName :: Name -> Name
singDataConName Name
nm
| Name
nm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nilName = String -> Name
mkName String
"SNil"
| Name
nm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
consName = String -> Name
mkName String
"SCons"
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
nm = Int -> Name
mkTupleName Int
degree
| Just Int
degree <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
nm = Int -> Name
mkTupleName Int
degree
| Bool
otherwise = String -> String -> Name -> Name
prefixConName String
"S" String
"%" Name
nm
singTyConName :: Name -> Name
singTyConName :: Name -> Name
singTyConName Name
name
| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
listName = String -> Name
mkName String
"SList"
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
name = Int -> Name
mkTupleName Int
degree
| Just Int
degree <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
name = Int -> Name
mkTupleName Int
degree
| Bool
otherwise = String -> String -> Name -> Name
prefixName String
"S" String
"%" Name
name
mkTupleName :: Int -> Name
mkTupleName :: Int -> Name
mkTupleName Int
n = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"STuple" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
singClassName :: Name -> Name
singClassName :: Name -> Name
singClassName = Name -> Name
singTyConName
singValName :: Name -> Name
singValName :: Name -> Name
singValName Name
n
| Just (String
us, String
rest) <- String -> Maybe (String, String)
splitUnderscores (Name -> String
nameBase Name
n)
= String -> String -> Name -> Name
prefixName (String
us String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s") String
"%" (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
rest
| Bool
otherwise
= String -> String -> Name -> Name
prefixName String
"s" String
"%" (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
upcase Name
n