{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Dhall.TH
(
staticDhallExpression
, makeHaskellTypeFromUnion
, makeHaskellTypes
, HaskellType(..)
) where
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Pretty)
import Dhall.Syntax (Expr(..))
import Dhall (FromDhall, ToDhall)
import GHC.Generics (Generic)
import Language.Haskell.TH.Quote (dataToExpQ)
import Language.Haskell.TH.Syntax
( Con(..)
, Dec(..)
, Exp(..)
, Q
, Type(..)
, Bang(..)
, SourceStrictness(..)
, SourceUnpackedness(..)
#if MIN_VERSION_template_haskell(2,12,0)
, DerivClause(..)
, DerivStrategy(..)
#else
, Pred
#endif
)
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
import qualified Data.Typeable as Typeable
import qualified Dhall
import qualified Dhall.Core as Core
import qualified Dhall.Map
import qualified Dhall.Pretty
import qualified Dhall.Util
import qualified GHC.IO.Encoding
import qualified Numeric.Natural
import qualified System.IO
import qualified Language.Haskell.TH.Syntax as Syntax
staticDhallExpression :: Text -> Q Exp
staticDhallExpression :: Text -> Q Exp
staticDhallExpression text :: Text
text = do
IO () -> Q ()
forall a. IO a -> Q a
Syntax.runIO (TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
System.IO.utf8)
Expr Src Void
expression <- IO (Expr Src Void) -> Q (Expr Src Void)
forall a. IO a -> Q a
Syntax.runIO (Text -> IO (Expr Src Void)
Dhall.inputExpr Text
text)
(forall b. Data b => b -> Maybe (Q Exp)) -> Expr Src Void -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
dataToExpQ (\a :: b
a -> Text -> Q Exp
liftText (Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
Typeable.cast b
a) Expr Src Void
expression
where
liftText :: Text -> Q Exp
liftText = (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'Text.pack)) (Q Exp -> Q Exp) -> (Text -> Q Exp) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
forall t. Lift t => t -> Q Exp
Syntax.lift (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
toNestedHaskellType
:: (Eq a, Pretty a)
=> [HaskellType (Expr s a)]
-> Expr s a
-> Q Type
toNestedHaskellType :: [HaskellType (Expr s a)] -> Expr s a -> Q Type
toNestedHaskellType haskellTypes :: [HaskellType (Expr s a)]
haskellTypes = Expr s a -> Q Type
forall (m :: * -> *) s. MonadFail m => Expr s a -> m Type
loop
where
loop :: Expr s a -> m Type
loop dhallType :: Expr s a
dhallType = case Expr s a
dhallType of
Bool -> do
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT ''Bool)
Double -> do
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT ''Double)
Integer -> do
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT ''Integer)
Natural -> do
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT ''Numeric.Natural.Natural)
Text -> do
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT ''Text)
App List dhallElementType :: Expr s a
dhallElementType -> do
Type
haskellElementType <- Expr s a -> m Type
loop Expr s a
dhallElementType
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type -> Type
AppT (Name -> Type
ConT ''[]) Type
haskellElementType)
App Optional dhallElementType :: Expr s a
dhallElementType -> do
Type
haskellElementType <- Expr s a -> m Type
loop Expr s a
dhallElementType
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) Type
haskellElementType)
_ | Just haskellType :: HaskellType (Expr s a)
haskellType <- (HaskellType (Expr s a) -> Bool)
-> [HaskellType (Expr s a)] -> Maybe (HaskellType (Expr s a))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find HaskellType (Expr s a) -> Bool
forall s. HaskellType (Expr s a) -> Bool
predicate [HaskellType (Expr s a)]
haskellTypes -> do
let name :: Name
name = String -> Name
Syntax.mkName (Text -> String
Text.unpack (HaskellType (Expr s a) -> Text
forall code. HaskellType code -> Text
typeName HaskellType (Expr s a)
haskellType))
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT Name
name)
| Bool
otherwise -> do
let document :: Doc Ann
document =
[Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat
[ "Unsupported nested type\n"
, " \n"
, "Explanation: Not all Dhall types can be nested within Haskell datatype \n"
, "declarations. Specifically, only the following simple Dhall types are supported\n"
, "as a nested type inside of a data declaration: \n"
, " \n"
, "• ❰Bool❱ \n"
, "• ❰Double❱ \n"
, "• ❰Integer❱ \n"
, "• ❰Natural❱ \n"
, "• ❰Text❱ \n"
, "• ❰List a❱ (where ❰a❱ is also a valid nested type) \n"
, "• ❰Optional a❱ (where ❰a❱ is also a valid nested type) \n"
, "• Another matching datatype declaration \n"
, " \n"
, "The Haskell datatype generation logic encountered the following Dhall type: \n"
, " \n"
, " " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
dhallType Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\n"
, " \n"
, "... which did not fit any of the above criteria."
]
let message :: String
message = SimpleDocStream Ann -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
document)
String -> m Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
message
where
predicate :: HaskellType (Expr s a) -> Bool
predicate haskellType :: HaskellType (Expr s a)
haskellType =
Expr s a -> Expr s a -> Bool
forall a s t. Eq a => Expr s a -> Expr t a -> Bool
Core.judgmentallyEqual (HaskellType (Expr s a) -> Expr s a
forall code. HaskellType code -> code
code HaskellType (Expr s a)
haskellType) Expr s a
dhallType
#if MIN_VERSION_template_haskell(2,12,0)
derivingClauses :: [DerivClause]
derivingClauses :: [DerivClause]
derivingClauses =
[ Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) [ Name -> Type
ConT ''Generic ]
, Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy) [ Name -> Type
ConT ''FromDhall, Name -> Type
ConT ''ToDhall ]
]
#else
derivingClauses :: [Pred]
derivingClauses = [ ConT ''Generic, ConT ''FromDhall, ConT ''ToDhall ]
#endif
toDeclaration
:: (Eq a, Pretty a)
=> [HaskellType (Expr s a)]
-> HaskellType (Expr s a)
-> Q Dec
toDeclaration :: [HaskellType (Expr s a)] -> HaskellType (Expr s a) -> Q Dec
toDeclaration haskellTypes :: [HaskellType (Expr s a)]
haskellTypes MultipleConstructors{..} = do
case Expr s a
code of
Union kts :: Map Text (Maybe (Expr s a))
kts -> do
let name :: Name
name = String -> Name
Syntax.mkName (Text -> String
Text.unpack Text
typeName)
[Con]
constructors <- ((Text, Maybe (Expr s a)) -> Q Con)
-> [(Text, Maybe (Expr s a))] -> Q [Con]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([HaskellType (Expr s a)] -> (Text, Maybe (Expr s a)) -> Q Con
forall a s.
(Eq a, Pretty a) =>
[HaskellType (Expr s a)] -> (Text, Maybe (Expr s a)) -> Q Con
toConstructor [HaskellType (Expr s a)]
haskellTypes) (Map Text (Maybe (Expr s a)) -> [(Text, Maybe (Expr s a))]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList Map Text (Maybe (Expr s a))
kts )
Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
name [] Maybe Type
forall a. Maybe a
Nothing [Con]
constructors [DerivClause]
derivingClauses)
_ -> do
let document :: Doc Ann
document =
[Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat
[ "Dhall.TH.makeHaskellTypes: Not a union type\n"
, " \n"
, "Explanation: This function expects the ❰code❱ field of ❰MultipleConstructors❱ to\n"
, "evaluate to a union type. \n"
, " \n"
, "For example, this is a valid Dhall union type that this function would accept: \n"
, " \n"
, " \n"
, " ┌──────────────────────────────────────────────────────────────────┐ \n"
, " │ Dhall.TH.makeHaskellTypes (MultipleConstructors \"T\" \"< A | B >\") │ \n"
, " └──────────────────────────────────────────────────────────────────┘ \n"
, " \n"
, " \n"
, "... which corresponds to this Haskell type declaration: \n"
, " \n"
, " \n"
, " ┌────────────────┐ \n"
, " │ data T = A | B │ \n"
, " └────────────────┘ \n"
, " \n"
, " \n"
, "... but the following Dhall type is rejected due to being a bare record type: \n"
, " \n"
, " \n"
, " ┌──────────────────────────────────────────────┐ \n"
, " │ Dhall.TH.makeHaskellTypes \"T\" \"{ x : Bool }\" │ Not valid \n"
, " └──────────────────────────────────────────────┘ \n"
, " \n"
, " \n"
, "The Haskell datatype generation logic encountered the following Dhall type: \n"
, " \n"
, " " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
code Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\n"
, " \n"
, "... which is not a union type."
]
let message :: String
message = SimpleDocStream Ann -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
document)
String -> Q Dec
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
message
toDeclaration haskellTypes :: [HaskellType (Expr s a)]
haskellTypes SingleConstructor{..} = do
let name :: Name
name = String -> Name
Syntax.mkName (Text -> String
Text.unpack Text
typeName)
Con
constructor <- [HaskellType (Expr s a)] -> (Text, Maybe (Expr s a)) -> Q Con
forall a s.
(Eq a, Pretty a) =>
[HaskellType (Expr s a)] -> (Text, Maybe (Expr s a)) -> Q Con
toConstructor [HaskellType (Expr s a)]
haskellTypes (Text
constructorName, Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
code)
Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
name [] Maybe Type
forall a. Maybe a
Nothing [Con
constructor] [DerivClause]
derivingClauses)
toConstructor
:: (Eq a, Pretty a)
=> [HaskellType (Expr s a)]
-> (Text, Maybe (Expr s a))
-> Q Con
toConstructor :: [HaskellType (Expr s a)] -> (Text, Maybe (Expr s a)) -> Q Con
toConstructor haskellTypes :: [HaskellType (Expr s a)]
haskellTypes (constructorName :: Text
constructorName, maybeAlternativeType :: Maybe (Expr s a)
maybeAlternativeType) = do
let name :: Name
name = String -> Name
Syntax.mkName (Text -> String
Text.unpack Text
constructorName)
let bang :: Bang
bang = SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness
case Maybe (Expr s a)
maybeAlternativeType of
Just (Record kts :: Map Text (Expr s a)
kts) -> do
let process :: (Text, Expr s a) -> Q (Name, Bang, Type)
process (key :: Text
key, dhallFieldType :: Expr s a
dhallFieldType) = do
Type
haskellFieldType <- [HaskellType (Expr s a)] -> Expr s a -> Q Type
forall a s.
(Eq a, Pretty a) =>
[HaskellType (Expr s a)] -> Expr s a -> Q Type
toNestedHaskellType [HaskellType (Expr s a)]
haskellTypes Expr s a
dhallFieldType
(Name, Bang, Type) -> Q (Name, Bang, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Name
Syntax.mkName (Text -> String
Text.unpack Text
key), Bang
bang, Type
haskellFieldType)
[(Name, Bang, Type)]
varBangTypes <- ((Text, Expr s a) -> Q (Name, Bang, Type))
-> [(Text, Expr s a)] -> Q [(Name, Bang, Type)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Expr s a) -> Q (Name, Bang, Type)
process (Map Text (Expr s a) -> [(Text, Expr s a)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList Map Text (Expr s a)
kts)
Con -> Q Con
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [(Name, Bang, Type)] -> Con
RecC Name
name [(Name, Bang, Type)]
varBangTypes)
Just dhallAlternativeType :: Expr s a
dhallAlternativeType -> do
Type
haskellAlternativeType <- [HaskellType (Expr s a)] -> Expr s a -> Q Type
forall a s.
(Eq a, Pretty a) =>
[HaskellType (Expr s a)] -> Expr s a -> Q Type
toNestedHaskellType [HaskellType (Expr s a)]
haskellTypes Expr s a
dhallAlternativeType
Con -> Q Con
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [BangType] -> Con
NormalC Name
name [ (Bang
bang, Type
haskellAlternativeType) ])
Nothing -> do
Con -> Q Con
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [BangType] -> Con
NormalC Name
name [])
makeHaskellTypeFromUnion
:: Text
-> Text
-> Q [Dec]
makeHaskellTypeFromUnion :: Text -> Text -> Q [Dec]
makeHaskellTypeFromUnion typeName :: Text
typeName code :: Text
code =
[HaskellType Text] -> Q [Dec]
makeHaskellTypes [ MultipleConstructors :: forall code. Text -> code -> HaskellType code
MultipleConstructors{..} ]
data HaskellType code
= MultipleConstructors
{ HaskellType code -> Text
typeName :: Text
, HaskellType code -> code
code :: code
}
| SingleConstructor
{ typeName :: Text
, HaskellType code -> Text
constructorName :: Text
, code :: code
}
deriving (a -> HaskellType b -> HaskellType a
(a -> b) -> HaskellType a -> HaskellType b
(forall a b. (a -> b) -> HaskellType a -> HaskellType b)
-> (forall a b. a -> HaskellType b -> HaskellType a)
-> Functor HaskellType
forall a b. a -> HaskellType b -> HaskellType a
forall a b. (a -> b) -> HaskellType a -> HaskellType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HaskellType b -> HaskellType a
$c<$ :: forall a b. a -> HaskellType b -> HaskellType a
fmap :: (a -> b) -> HaskellType a -> HaskellType b
$cfmap :: forall a b. (a -> b) -> HaskellType a -> HaskellType b
Functor, HaskellType a -> Bool
(a -> m) -> HaskellType a -> m
(a -> b -> b) -> b -> HaskellType a -> b
(forall m. Monoid m => HaskellType m -> m)
-> (forall m a. Monoid m => (a -> m) -> HaskellType a -> m)
-> (forall m a. Monoid m => (a -> m) -> HaskellType a -> m)
-> (forall a b. (a -> b -> b) -> b -> HaskellType a -> b)
-> (forall a b. (a -> b -> b) -> b -> HaskellType a -> b)
-> (forall b a. (b -> a -> b) -> b -> HaskellType a -> b)
-> (forall b a. (b -> a -> b) -> b -> HaskellType a -> b)
-> (forall a. (a -> a -> a) -> HaskellType a -> a)
-> (forall a. (a -> a -> a) -> HaskellType a -> a)
-> (forall a. HaskellType a -> [a])
-> (forall a. HaskellType a -> Bool)
-> (forall a. HaskellType a -> Int)
-> (forall a. Eq a => a -> HaskellType a -> Bool)
-> (forall a. Ord a => HaskellType a -> a)
-> (forall a. Ord a => HaskellType a -> a)
-> (forall a. Num a => HaskellType a -> a)
-> (forall a. Num a => HaskellType a -> a)
-> Foldable HaskellType
forall a. Eq a => a -> HaskellType a -> Bool
forall a. Num a => HaskellType a -> a
forall a. Ord a => HaskellType a -> a
forall m. Monoid m => HaskellType m -> m
forall a. HaskellType a -> Bool
forall a. HaskellType a -> Int
forall a. HaskellType a -> [a]
forall a. (a -> a -> a) -> HaskellType a -> a
forall m a. Monoid m => (a -> m) -> HaskellType a -> m
forall b a. (b -> a -> b) -> b -> HaskellType a -> b
forall a b. (a -> b -> b) -> b -> HaskellType a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: HaskellType a -> a
$cproduct :: forall a. Num a => HaskellType a -> a
sum :: HaskellType a -> a
$csum :: forall a. Num a => HaskellType a -> a
minimum :: HaskellType a -> a
$cminimum :: forall a. Ord a => HaskellType a -> a
maximum :: HaskellType a -> a
$cmaximum :: forall a. Ord a => HaskellType a -> a
elem :: a -> HaskellType a -> Bool
$celem :: forall a. Eq a => a -> HaskellType a -> Bool
length :: HaskellType a -> Int
$clength :: forall a. HaskellType a -> Int
null :: HaskellType a -> Bool
$cnull :: forall a. HaskellType a -> Bool
toList :: HaskellType a -> [a]
$ctoList :: forall a. HaskellType a -> [a]
foldl1 :: (a -> a -> a) -> HaskellType a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HaskellType a -> a
foldr1 :: (a -> a -> a) -> HaskellType a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> HaskellType a -> a
foldl' :: (b -> a -> b) -> b -> HaskellType a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HaskellType a -> b
foldl :: (b -> a -> b) -> b -> HaskellType a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HaskellType a -> b
foldr' :: (a -> b -> b) -> b -> HaskellType a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HaskellType a -> b
foldr :: (a -> b -> b) -> b -> HaskellType a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> HaskellType a -> b
foldMap' :: (a -> m) -> HaskellType a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HaskellType a -> m
foldMap :: (a -> m) -> HaskellType a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HaskellType a -> m
fold :: HaskellType m -> m
$cfold :: forall m. Monoid m => HaskellType m -> m
Foldable, Functor HaskellType
Foldable HaskellType
(Functor HaskellType, Foldable HaskellType) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HaskellType a -> f (HaskellType b))
-> (forall (f :: * -> *) a.
Applicative f =>
HaskellType (f a) -> f (HaskellType a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HaskellType a -> m (HaskellType b))
-> (forall (m :: * -> *) a.
Monad m =>
HaskellType (m a) -> m (HaskellType a))
-> Traversable HaskellType
(a -> f b) -> HaskellType a -> f (HaskellType b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
HaskellType (m a) -> m (HaskellType a)
forall (f :: * -> *) a.
Applicative f =>
HaskellType (f a) -> f (HaskellType a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HaskellType a -> m (HaskellType b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HaskellType a -> f (HaskellType b)
sequence :: HaskellType (m a) -> m (HaskellType a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
HaskellType (m a) -> m (HaskellType a)
mapM :: (a -> m b) -> HaskellType a -> m (HaskellType b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HaskellType a -> m (HaskellType b)
sequenceA :: HaskellType (f a) -> f (HaskellType a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HaskellType (f a) -> f (HaskellType a)
traverse :: (a -> f b) -> HaskellType a -> f (HaskellType b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HaskellType a -> f (HaskellType b)
$cp2Traversable :: Foldable HaskellType
$cp1Traversable :: Functor HaskellType
Traversable)
makeHaskellTypes :: [HaskellType Text] -> Q [Dec]
makeHaskellTypes :: [HaskellType Text] -> Q [Dec]
makeHaskellTypes haskellTypes :: [HaskellType Text]
haskellTypes = do
IO () -> Q ()
forall a. IO a -> Q a
Syntax.runIO (TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
System.IO.utf8)
[HaskellType (Expr Src Void)]
haskellTypes' <- (HaskellType Text -> Q (HaskellType (Expr Src Void)))
-> [HaskellType Text] -> Q [HaskellType (Expr Src Void)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> Q (Expr Src Void))
-> HaskellType Text -> Q (HaskellType (Expr Src Void))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IO (Expr Src Void) -> Q (Expr Src Void)
forall a. IO a -> Q a
Syntax.runIO (IO (Expr Src Void) -> Q (Expr Src Void))
-> (Text -> IO (Expr Src Void)) -> Text -> Q (Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO (Expr Src Void)
Dhall.inputExpr)) [HaskellType Text]
haskellTypes
(HaskellType (Expr Src Void) -> Q Dec)
-> [HaskellType (Expr Src Void)] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([HaskellType (Expr Src Void)]
-> HaskellType (Expr Src Void) -> Q Dec
forall a s.
(Eq a, Pretty a) =>
[HaskellType (Expr s a)] -> HaskellType (Expr s a) -> Q Dec
toDeclaration [HaskellType (Expr Src Void)]
haskellTypes') [HaskellType (Expr Src Void)]
haskellTypes'