{-# LANGUAGE CPP #-}
module Foreign.Hoppy.Generator.Std.Map (
Options (..),
defaultOptions,
Contents (..),
instantiate,
instantiate',
toExports,
) where
import Control.Monad (forM_, when)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat)
#endif
import Foreign.Hoppy.Generator.Language.Haskell (
HsTypeSide (HsHsSide),
addImports,
cppTypeToHsTypeAndUse,
indent,
ln,
prettyPrint,
sayLn,
saysLn,
)
import Foreign.Hoppy.Generator.Spec (
Constness (Const, Nonconst),
Export (Export),
Operator (OpArray, OpEq),
Purity (Nonpure),
Reqs,
Type,
addAddendumHaskell,
addReqs,
hsImports,
hsImportForPrelude,
hsImportForRuntime,
ident1T,
ident2,
ident2T,
identT',
includeStd,
np,
reqInclude,
toExtName,
)
import Foreign.Hoppy.Generator.Spec.Class (
Class,
MethodApplicability (MConst, MNormal),
makeClass,
makeFnMethod,
mkConstMethod,
mkConstMethod',
mkCtor,
mkMethod,
mkMethod',
toHsDataTypeName,
toHsClassEntityName,
)
import Foreign.Hoppy.Generator.Spec.ClassFeature (
ClassFeature (Assignable, Copyable),
classAddFeatures,
)
import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))
import Foreign.Hoppy.Generator.Std.Internal (includeHelper)
import Foreign.Hoppy.Generator.Std.Iterator
import Foreign.Hoppy.Generator.Types
data Options = Options
{ Options -> [ClassFeature]
optMapClassFeatures :: [ClassFeature]
, Options -> Maybe ValueConversion
optKeyConversion :: Maybe ValueConversion
, Options -> Maybe ValueConversion
optValueConversion :: Maybe ValueConversion
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = [ClassFeature]
-> Maybe ValueConversion -> Maybe ValueConversion -> Options
Options [] Maybe ValueConversion
forall a. Maybe a
Nothing Maybe ValueConversion
forall a. Maybe a
Nothing
data Contents = Contents
{ Contents -> Class
c_map :: Class
, Contents -> Class
c_iterator :: Class
, Contents -> Class
c_constIterator :: Class
}
instantiate :: String -> Type -> Type -> Reqs -> Contents
instantiate :: String -> Type -> Type -> Reqs -> Contents
instantiate String
mapName Type
k Type
v Reqs
reqs = String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' String
mapName Type
k Type
v Reqs
reqs Options
defaultOptions
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' String
mapName Type
k Type
v Reqs
userReqs Options
opts =
let extName :: ExtName
extName = HasCallStack => String -> ExtName
String -> ExtName
toExtName String
mapName
reqs :: Reqs
reqs = [Reqs] -> Reqs
forall a. Monoid a => [a] -> a
mconcat
[ Reqs
userReqs
, Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeHelper String
"map.hpp"
, Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"map"
]
iteratorName :: String
iteratorName = String
mapName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Iterator"
constIteratorName :: String
constIteratorName = String
mapName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ConstIterator"
getIteratorKeyIdent :: Identifier
getIteratorKeyIdent = String -> String -> String -> [Type] -> Identifier
ident2T String
"hoppy" String
"map" String
"getIteratorKey" [Type
k, Type
v]
getIteratorValueIdent :: Identifier
getIteratorValueIdent = String -> String -> String -> [Type] -> Identifier
ident2T String
"hoppy" String
"map" String
"getIteratorValue" [Type
k, Type
v]
map' :: Class
map' =
(case (Options -> Maybe ValueConversion
optKeyConversion Options
opts, Options -> Maybe ValueConversion
optValueConversion Options
opts) of
(Maybe ValueConversion
Nothing, Maybe ValueConversion
Nothing) -> Class -> Class
forall a. a -> a
id
(Just ValueConversion
keyConv, Just ValueConversion
valueConv) -> Generator () -> Class -> Class
forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell (Generator () -> Class -> Class) -> Generator () -> Class -> Class
forall a b. (a -> b) -> a -> b
$ ValueConversion -> ValueConversion -> Generator ()
makeAddendum ValueConversion
keyConv ValueConversion
valueConv
(Maybe ValueConversion
maybeKeyConv, Maybe ValueConversion
maybeValueConv) ->
String -> Class -> Class
forall a. HasCallStack => String -> a
error (String -> Class -> Class) -> String -> Class -> Class
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"Error instantiating std::map<", Type -> String
forall a. Show a => a -> String
show Type
k, String
", ", Type -> String
forall a. Show a => a -> String
show Type
v, String
"> (external name ",
ExtName -> String
forall a. Show a => a -> String
show ExtName
extName, String
"), key and value conversions must either both be specified or ",
String
"absent; they are, repectively, ", Maybe ValueConversion -> String
forall a. Show a => a -> String
show Maybe ValueConversion
maybeKeyConv, String
" and ", Maybe ValueConversion -> String
forall a. Show a => a -> String
show Maybe ValueConversion
maybeValueConv,
String
"."]) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
[ClassFeature] -> Class -> Class
classAddFeatures (ClassFeature
Assignable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: ClassFeature
Copyable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: Options -> [ClassFeature]
optMapClassFeatures Options
opts) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (String -> String -> [Type] -> Identifier
ident1T String
"std" String
"map" [Type
k, Type
v]) (ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just ExtName
extName) []
[ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [Parameter]
np
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"at" String
"at" [Type
k] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
v
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"at" String
"atConst" [Type
k] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
v
, String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"begin" String
"begin" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
, String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"begin" String
"beginConst" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
constIterator
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"clear" [Parameter]
np Type
voidT
, String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"count" [Type
k] Type
sizeT
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"empty" [Parameter]
np Type
boolT
, String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"end" String
"end" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
, String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"end" String
"endConst" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
constIterator
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"erase" String
"erase" [Class -> Type
objT Class
iterator] Type
voidT
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"erase" String
"eraseKey" [Type
k] Type
sizeT
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"erase" String
"eraseRange" [Class -> Type
objT Class
iterator, Class -> Type
objT Class
iterator] Type
voidT
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"find" String
"find" [Type
k] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"find" String
"findConst" [Type
k] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
constIterator
, String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"max_size" String
"maxSize" [Parameter]
np Type
sizeT
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"size" [Parameter]
np Type
sizeT
, String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"swap" [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
map'] Type
voidT
, Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod Operator
OpArray [Type
k] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
v
]
iterator :: Class
iterator =
Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
Mutable Maybe Type
forall a. Maybe a
Nothing (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass ([(String, Maybe [Type])] -> Identifier
identT' [(String
"std", Maybe [Type]
forall a. Maybe a
Nothing),
(String
"map", [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type
k, Type
v]),
(String
"iterator", Maybe [Type]
forall a. Maybe a
Nothing)])
(ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
iteratorName) []
[ Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod Identifier
getIteratorKeyIdent String
"getKey" MethodApplicability
MConst Purity
Nonpure
[Class -> Type
objT Class
iterator] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
k
, Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod Identifier
getIteratorValueIdent String
"getValue" MethodApplicability
MNormal Purity
Nonpure
[Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
v
, Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod Identifier
getIteratorValueIdent String
"getValueConst" MethodApplicability
MConst Purity
Nonpure
[Class -> Type
objT Class
iterator] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
v
]
constIterator :: Class
constIterator =
Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
Constant Maybe Type
forall a. Maybe a
Nothing (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass ([(String, Maybe [Type])] -> Identifier
identT' [(String
"std", Maybe [Type]
forall a. Maybe a
Nothing),
(String
"map", [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type
k, Type
v]),
(String
"const_iterator", Maybe [Type]
forall a. Maybe a
Nothing)])
(ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
constIteratorName)
[]
[ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newFromConst" [Class -> Type
objT Class
iterator]
, Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod (String -> String -> String -> Identifier
ident2 String
"hoppy" String
"iterator" String
"deconst") String
"deconst" MethodApplicability
MConst Purity
Nonpure
[Class -> Type
objT Class
constIterator, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
map'] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
, Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod Identifier
getIteratorKeyIdent String
"getKey" MethodApplicability
MConst Purity
Nonpure
[Class -> Type
objT Class
constIterator] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
k
, Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod Identifier
getIteratorValueIdent String
"getValueConst" MethodApplicability
MConst Purity
Nonpure
[Class -> Type
objT Class
constIterator] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
v
]
makeAddendum :: ValueConversion -> ValueConversion -> Generator ()
makeAddendum ValueConversion
keyConv ValueConversion
valueConv = do
HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> [String] -> HsImportSet
hsImports String
"Prelude" [String
"($)", String
"(=<<)"],
HsImportSet
hsImportForPrelude,
HsImportSet
hsImportForRuntime]
[Constness] -> (Constness -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constness
Const, Constness
Nonconst] ((Constness -> Generator ()) -> Generator ())
-> (Constness -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Constness
cst -> do
String
hsDataTypeName <- Constness -> Class -> Generator String
toHsDataTypeName Constness
cst Class
map'
HsType
keyHsType <-
HsTypeSide -> Type -> Generator HsType
cppTypeToHsTypeAndUse HsTypeSide
HsHsSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$
(case ValueConversion
keyConv of
ValueConversion
ConvertPtr -> Type -> Type
ptrT
ValueConversion
ConvertValue -> Type -> Type
forall a. a -> a
id) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Type -> Type
constT Type
k
HsType
valueHsType <-
HsTypeSide -> Type -> Generator HsType
cppTypeToHsTypeAndUse HsTypeSide
HsHsSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$
(case ValueConversion
valueConv of
ValueConversion
ConvertPtr -> Type -> Type
ptrT
ValueConversion
ConvertValue -> Type -> Type
forall a. a -> a
id) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
case Constness
cst of
Constness
Const -> Type -> Type
constT Type
v
Constness
Nonconst -> Type
v
Generator ()
ln
[String] -> Generator ()
saysLn [String
"instance HoppyFHR.HasContents ", String
hsDataTypeName,
String
" ((", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
keyHsType, String
"), (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
valueHsType, String
")) where"]
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String -> Generator ()
sayLn String
"toContents this' = do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String
mapEmpty <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
map' String
"empty"
String
mapBegin <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
map' (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
Constness
Const -> String
"beginConst"
Constness
Nonconst -> String
"begin"
String
mapEnd <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
map' (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
Constness
Const -> String
"endConst"
Constness
Nonconst -> String
"end"
let iter :: Class
iter = case Constness
cst of
Constness
Const -> Class
constIterator
Constness
Nonconst -> Class
iterator
String
iterEq <- Class -> Operator -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter Operator
OpEq
String
iterGetKey <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter String
"getKey"
String
iterGetValue <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
Constness
Const -> String
"getValueConst"
Constness
Nonconst -> String
"getValue"
String
iterPrev <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter String
"prev"
[String] -> Generator ()
saysLn [String
"empty' <- ", String
mapEmpty, String
" this'"]
String -> Generator ()
sayLn String
"if empty' then HoppyP.return [] else do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
[String] -> Generator ()
saysLn [String
"begin' <- ", String
mapBegin, String
" this'"]
[String] -> Generator ()
saysLn [String
"iter' <- ", String
mapEnd, String
" this'"]
String -> Generator ()
sayLn String
"go' iter' begin' []"
String -> Generator ()
sayLn String
"where"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String -> Generator ()
sayLn String
"go' iter' begin' acc' = do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
[String] -> Generator ()
saysLn [String
"stop' <- ", String
iterEq, String
" iter' begin'"]
String -> Generator ()
sayLn String
"if stop' then HoppyP.return acc' else do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
[String] -> Generator ()
saysLn [String
"_ <- ", String
iterPrev, String
" iter'"]
[String] -> Generator ()
saysLn [String
"key' <- ",
case ValueConversion
keyConv of
ValueConversion
ConvertPtr -> String
""
ValueConversion
ConvertValue -> String
"HoppyFHR.decode =<< ",
String
iterGetKey, String
" iter'"]
[String] -> Generator ()
saysLn [String
"value' <- ",
case ValueConversion
valueConv of
ValueConversion
ConvertPtr -> String
""
ValueConversion
ConvertValue -> String
"HoppyFHR.decode =<< ",
String
iterGetValue, String
" iter'"]
String -> Generator ()
sayLn String
"go' iter' begin' $ (key', value'):acc'"
Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Constness
cst Constness -> Constness -> Bool
forall a. Eq a => a -> a -> Bool
== Constness
Nonconst) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
Generator ()
ln
[String] -> Generator ()
saysLn [String
"instance HoppyFHR.FromContents ", String
hsDataTypeName,
String
" ((", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
keyHsType, String
"), (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
valueHsType, String
")) where"]
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String -> Generator ()
sayLn String
"fromContents values' = do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String
mapNew <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
map' String
"new"
String
mapAt <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
map' String
"at"
[String] -> Generator ()
saysLn [String
"map' <- ", String
mapNew]
[String] -> Generator ()
saysLn [String
"HoppyP.mapM_ (\\(k, v) -> HoppyP.flip HoppyFHR.assign v =<< ",
String
mapAt, String
" map' k) values'"]
String -> Generator ()
sayLn String
"HoppyP.return map'"
in Contents :: Class -> Class -> Class -> Contents
Contents
{ c_map :: Class
c_map = Class
map'
, c_iterator :: Class
c_iterator = Class
iterator
, c_constIterator :: Class
c_constIterator = Class
constIterator
}
toExports :: Contents -> [Export]
toExports :: Contents -> [Export]
toExports Contents
m = ((Contents -> Class) -> Export) -> [Contents -> Class] -> [Export]
forall a b. (a -> b) -> [a] -> [b]
map (Class -> Export
forall a. Exportable a => a -> Export
Export (Class -> Export)
-> ((Contents -> Class) -> Class) -> (Contents -> Class) -> Export
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Contents -> Class) -> Contents -> Class
forall a b. (a -> b) -> a -> b
$ Contents
m)) [Contents -> Class
c_map, Contents -> Class
c_iterator, Contents -> Class
c_constIterator]