{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Singletons.TH.Options
(
Options, defaultOptions
, genQuotedDecs
, genSingKindInsts
, 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.Names ( consName, listName, nilName
, mk_name_tc, mkTupleDataName, mkTupleTypeName
, sconsName, sListName, snilName
, splitUnderscores
)
import Data.Singletons.Util
import Language.Haskell.TH.Desugar
import Language.Haskell.TH.Syntax hiding (Lift(..))
data Options = Options
{ Options -> Bool
genQuotedDecs :: Bool
, Options -> Bool
genSingKindInsts :: Bool
, 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 :: Bool
-> Bool
-> (Name -> Name)
-> (Name -> Maybe Uniq -> Name)
-> (Name -> Name)
-> (Name -> Name)
-> (Name -> Name)
-> (Name -> Name)
-> (Name -> Int -> Name)
-> Options
Options
{ genQuotedDecs :: Bool
genQuotedDecs = Bool
True
, genSingKindInsts :: Bool
genSingKindInsts = Bool
True
, 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 (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 (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 (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 (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 (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 (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 (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 ( a -> OptionsM m b -> OptionsM m a
(a -> b) -> OptionsM m a -> OptionsM m b
(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
<$ :: a -> OptionsM m b -> OptionsM m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> OptionsM m b -> OptionsM m a
fmap :: (a -> b) -> OptionsM m a -> OptionsM m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OptionsM m a -> OptionsM m b
Functor, Functor (OptionsM m)
a -> OptionsM m a
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)
OptionsM m a -> OptionsM m b -> OptionsM m b
OptionsM m a -> OptionsM m b -> OptionsM m a
OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
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
<* :: OptionsM m a -> OptionsM m b -> OptionsM m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m a
*> :: OptionsM m a -> OptionsM m b -> OptionsM m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
liftA2 :: (a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OptionsM m a -> OptionsM m b -> OptionsM m c
<*> :: OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsM m (a -> b) -> OptionsM m a -> OptionsM m b
pure :: a -> OptionsM m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> OptionsM m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (OptionsM m)
Applicative, Applicative (OptionsM m)
a -> OptionsM m a
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)
OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
OptionsM m a -> OptionsM m b -> OptionsM m b
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
return :: a -> OptionsM m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> OptionsM m a
>> :: OptionsM m a -> OptionsM m b -> OptionsM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> OptionsM m b -> OptionsM m b
>>= :: OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OptionsM m a -> (a -> OptionsM m b) -> OptionsM m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (OptionsM m)
Monad, m a -> OptionsM m a
(forall (m :: * -> *) a. Monad m => m a -> OptionsM m a)
-> MonadTrans OptionsM
forall (m :: * -> *) a. Monad m => m a -> OptionsM m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> OptionsM m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> OptionsM m a
MonadTrans
, MonadFail (OptionsM m)
MonadIO (OptionsM m)
OptionsM m [Extension]
OptionsM m (Maybe a)
OptionsM m Loc
a -> OptionsM m ()
Bool -> String -> OptionsM m (Maybe Name)
Bool -> String -> OptionsM m ()
String -> OptionsM m String
String -> OptionsM m Name
String -> OptionsM m ()
[Dec] -> OptionsM m ()
IO a -> OptionsM m a
Q () -> OptionsM m ()
Name -> OptionsM m [DecidedStrictness]
Name -> OptionsM m [Role]
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)
-> (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]
-> Quasi (OptionsM m)
Extension -> OptionsM m Bool
ForeignSrcLang -> String -> OptionsM m ()
Module -> OptionsM m ModuleInfo
AnnLookup -> OptionsM m [a]
OptionsM m a -> OptionsM m a -> OptionsM m a
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)
-> (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]
-> Quasi m
forall (m :: * -> *). Quasi m => MonadFail (OptionsM m)
forall (m :: * -> *). Quasi m => MonadIO (OptionsM m)
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 [DecidedStrictness]
forall (m :: * -> *). Quasi m => Name -> OptionsM m [Role]
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 => Extension -> OptionsM m Bool
forall (m :: * -> *).
Quasi m =>
ForeignSrcLang -> 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
qExtsEnabled :: OptionsM m [Extension]
$cqExtsEnabled :: forall (m :: * -> *). Quasi m => OptionsM m [Extension]
qIsExtEnabled :: Extension -> OptionsM m Bool
$cqIsExtEnabled :: forall (m :: * -> *). Quasi m => Extension -> OptionsM m Bool
qPutQ :: a -> OptionsM m ()
$cqPutQ :: forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> OptionsM m ()
qGetQ :: OptionsM m (Maybe a)
$cqGetQ :: forall (m :: * -> *) a.
(Quasi m, Typeable a) =>
OptionsM m (Maybe a)
qAddCorePlugin :: String -> OptionsM m ()
$cqAddCorePlugin :: forall (m :: * -> *). Quasi m => String -> OptionsM m ()
qAddModFinalizer :: Q () -> OptionsM m ()
$cqAddModFinalizer :: forall (m :: * -> *). Quasi m => Q () -> OptionsM m ()
qAddForeignFilePath :: ForeignSrcLang -> String -> OptionsM m ()
$cqAddForeignFilePath :: forall (m :: * -> *).
Quasi m =>
ForeignSrcLang -> String -> OptionsM m ()
qAddTopDecls :: [Dec] -> OptionsM m ()
$cqAddTopDecls :: forall (m :: * -> *). Quasi m => [Dec] -> OptionsM m ()
qAddTempFile :: String -> OptionsM m String
$cqAddTempFile :: forall (m :: * -> *). Quasi m => String -> OptionsM m String
qAddDependentFile :: String -> OptionsM m ()
$cqAddDependentFile :: forall (m :: * -> *). Quasi m => String -> OptionsM m ()
qRunIO :: IO a -> OptionsM m a
$cqRunIO :: forall (m :: * -> *) a. Quasi m => IO a -> OptionsM m a
qLocation :: OptionsM m Loc
$cqLocation :: forall (m :: * -> *). Quasi m => OptionsM m Loc
qReifyConStrictness :: Name -> OptionsM m [DecidedStrictness]
$cqReifyConStrictness :: forall (m :: * -> *).
Quasi m =>
Name -> OptionsM m [DecidedStrictness]
qReifyModule :: Module -> OptionsM m ModuleInfo
$cqReifyModule :: forall (m :: * -> *). Quasi m => Module -> OptionsM m ModuleInfo
qReifyAnnotations :: AnnLookup -> OptionsM m [a]
$cqReifyAnnotations :: forall (m :: * -> *) a.
(Quasi m, Data a) =>
AnnLookup -> OptionsM m [a]
qReifyRoles :: Name -> OptionsM m [Role]
$cqReifyRoles :: forall (m :: * -> *). Quasi m => Name -> OptionsM m [Role]
qReifyInstances :: Name -> [Type] -> OptionsM m [Dec]
$cqReifyInstances :: forall (m :: * -> *). Quasi m => Name -> [Type] -> OptionsM m [Dec]
qReifyType :: Name -> OptionsM m Type
$cqReifyType :: forall (m :: * -> *). Quasi m => Name -> OptionsM m Type
qReifyFixity :: Name -> OptionsM m (Maybe Fixity)
$cqReifyFixity :: forall (m :: * -> *). Quasi m => Name -> OptionsM m (Maybe Fixity)
qReify :: Name -> OptionsM m Info
$cqReify :: forall (m :: * -> *). Quasi m => Name -> OptionsM m Info
qLookupName :: Bool -> String -> OptionsM m (Maybe Name)
$cqLookupName :: forall (m :: * -> *).
Quasi m =>
Bool -> String -> OptionsM m (Maybe Name)
qRecover :: OptionsM m a -> OptionsM m a -> OptionsM m a
$cqRecover :: forall (m :: * -> *) a.
Quasi m =>
OptionsM m a -> OptionsM m a -> OptionsM m a
qReport :: Bool -> String -> OptionsM m ()
$cqReport :: forall (m :: * -> *). Quasi m => Bool -> String -> OptionsM m ()
qNewName :: String -> OptionsM m Name
$cqNewName :: forall (m :: * -> *). Quasi m => String -> OptionsM m Name
$cp2Quasi :: forall (m :: * -> *). Quasi m => MonadFail (OptionsM m)
$cp1Quasi :: forall (m :: * -> *). Quasi m => MonadIO (OptionsM m)
Quasi, Monad (OptionsM m)
Monad (OptionsM m)
-> (forall a. String -> OptionsM m a) -> MonadFail (OptionsM m)
String -> OptionsM m a
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
fail :: String -> OptionsM m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> OptionsM m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (OptionsM m)
MonadFail, Monad (OptionsM m)
Monad (OptionsM m)
-> (forall a. IO a -> OptionsM m a) -> MonadIO (OptionsM m)
IO a -> OptionsM m a
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
liftIO :: IO a -> OptionsM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> OptionsM m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (OptionsM m)
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]
localDeclarations :: OptionsM m [Dec]
$clocalDeclarations :: forall (m :: * -> *). DsMonad m => OptionsM m [Dec]
$cp2DsMonad :: forall (m :: * -> *). DsMonad m => MonadFail (OptionsM m)
$cp1DsMonad :: forall (m :: * -> *). DsMonad m => Quasi (OptionsM m)
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 :: 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
name
= String -> String -> Name
mk_name_tc String
"Data.Singletons.Prelude.Instances" (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. [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
"#"
singDataConName :: Name -> Name
singDataConName :: Name -> Name
singDataConName Name
nm
| Name
nm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nilName = Name
snilName
| Name
nm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
consName = Name
sconsName
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
nm = Int -> Name
mkTupleDataName Int
degree
| Just Int
degree <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
nm = Int -> Name
mkTupleDataName 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 = Name
sListName
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
name = Int -> Name
mkTupleTypeName Int
degree
| Just Int
degree <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
name = Int -> Name
mkTupleTypeName Int
degree
| Bool
otherwise = String -> String -> Name -> Name
prefixName String
"S" String
"%" Name
name
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