{-# LANGUAGE TemplateHaskell #-}
module Data.API.Tools.Enum
( enumTool
, text_enum_nm
, map_enum_nm
) where
import Data.API.TH
import Data.API.Tools.Combinators
import Data.API.Tools.Datatypes
import Data.API.Types
import qualified Data.Text as T
import qualified Data.Map as Map
import Language.Haskell.TH
enumTool :: APITool
enumTool :: APITool
enumTool = Tool APINode -> APITool
apiNodeTool forall a b. (a -> b) -> a -> b
$ Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> Tool APINode
apiSpecTool forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Tool (APINode, SpecEnum)
enum forall a. Monoid a => a
mempty
where
enum :: Tool (APINode, SpecEnum)
enum = forall a. (a -> Q [Dec]) -> Tool a
simpleTool (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry APINode -> SpecEnum -> Q [Dec]
gen_se_tx) forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Q [Dec]) -> Tool a
simpleTool (APINode -> Q [Dec]
gen_se_mp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
text_enum_nm :: APINode -> Name
text_enum_nm :: APINode -> Name
text_enum_nm APINode
an = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"_text_" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (TypeName -> Text
_TypeName forall a b. (a -> b) -> a -> b
$ APINode -> TypeName
anName APINode
an)
gen_se_tx :: APINode -> SpecEnum -> Q [Dec]
gen_se_tx :: APINode -> SpecEnum -> Q [Dec]
gen_se_tx APINode
as SpecEnum
se = Name -> TypeQ -> ExpQ -> Q [Dec]
simpleSigD (APINode -> Name
text_enum_nm APINode
as)
[t| $tc -> T.Text |]
ExpQ
bdy
where
tc :: TypeQ
tc = forall (m :: * -> *). Quote m => Name -> m Type
conT forall a b. (a -> b) -> a -> b
$ APINode -> Name
rep_type_nm APINode
as
bdy :: ExpQ
bdy = forall (m :: * -> *). Quote m => [m Match] -> m Exp
lamCaseE [ forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match (FieldName -> PatQ
pt FieldName
fnm) (forall {m :: * -> *}. Quote m => FieldName -> m Body
bd FieldName
fnm) []
| (FieldName
fnm,String
_) <- SpecEnum -> [(FieldName, String)]
seAlts SpecEnum
se ]
pt :: FieldName -> PatQ
pt FieldName
fnm = APINode -> FieldName -> [PatQ] -> PatQ
nodeAltConP APINode
as FieldName
fnm []
bd :: FieldName -> m Body
bd FieldName
fnm = forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => String -> m Exp
stringE forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ FieldName -> Text
_FieldName FieldName
fnm
map_enum_nm :: APINode -> Name
map_enum_nm :: APINode -> Name
map_enum_nm APINode
an = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"_map_" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (TypeName -> Text
_TypeName forall a b. (a -> b) -> a -> b
$ APINode -> TypeName
anName APINode
an)
gen_se_mp :: APINode -> Q [Dec]
gen_se_mp :: APINode -> Q [Dec]
gen_se_mp APINode
as = Name -> TypeQ -> ExpQ -> Q [Dec]
simpleSigD (APINode -> Name
map_enum_nm APINode
as)
[t| Map.Map T.Text $tc |]
[e| genTextMap $(varE $ text_enum_nm as) |]
where
tc :: TypeQ
tc = forall (m :: * -> *). Quote m => Name -> m Type
conT forall a b. (a -> b) -> a -> b
$ APINode -> Name
rep_type_nm APINode
as
genTextMap :: (Ord a,Bounded a,Enum a) => (a->T.Text) -> Map.Map T.Text a
genTextMap :: forall a. (Ord a, Bounded a, Enum a) => (a -> Text) -> Map Text a
genTextMap a -> Text
f = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (a -> Text
f a
x,a
x) | a
x<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound] ]