{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC  -Wno-incomplete-uni-patterns #-}

module Elminator.ELM.Generator
  ( generateElm
  , typeDescriptorToDecoder
  , elmFront
  ) where

import Control.Monad.Reader as R
import Data.Aeson as Aeson
import qualified Data.List as DL
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Maybe
import Data.Text as T hiding (any, zipWith)
import qualified Elminator.ELM.Elm18 as Elm18
import qualified Elminator.ELM.Elm19 as Elm19
import Elminator.ELM.Render
import Elminator.Generics.Simple
import Elminator.Lib
import Language.Haskell.TH
import Prelude
import qualified Prelude as P

elmFront :: Text -> GenM (Text -> Text)
elmFront :: Text -> GenM (Text -> Text)
elmFront Text
moduleName = do
  (ElmVersion
ev, GenConfig
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  case ElmVersion
ev of
    ElmVersion
Elm0p19 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Elm19.elmFront Text
moduleName
    ElmVersion
Elm0p18 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Elm18.elmFront Text
moduleName

listEncoder :: GenM EExpr
listEncoder :: GenM EExpr
listEncoder = do
  (ElmVersion
ev, GenConfig
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  case ElmVersion
ev of
    ElmVersion
Elm0p19 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EExpr
Elm19.listEncoder
    ElmVersion
Elm0p18 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EExpr
Elm18.listEncoder

generateTupleEncoder :: Int -> [TypeDescriptor] -> GenM EDec
generateTupleEncoder :: Int -> [TypeDescriptor] -> GenM EDec
generateTupleEncoder Int
idx [TypeDescriptor]
types = do
  EExpr
eexpr <- GenM EExpr
getExpr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Text -> FSig -> [Text] -> EExpr -> EDec
EFunc ([Text] -> Text
T.concat [Text
"encodeTuple", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx]) forall a. Maybe a
Nothing [Text
tlVar] forall a b. (a -> b) -> a -> b
$
    [EDec] -> EExpr -> EExpr
ELet [EPattern -> EExpr -> EDec
EBinding ([EPattern] -> EPattern
ETupleP [EPattern]
patterns) (Text -> EExpr
EName Text
tlVar)] EExpr
eexpr
  where
    tlVar :: Text
tlVar = [Text] -> Text
T.concat [Text
"a", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx, Text
"1"]
    indexVar :: Int -> Text
    indexVar :: Int -> Text
indexVar Int
y = [Text] -> Text
T.concat [Text
"b", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx, Text
"_", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
y]
    varList :: [Text]
    varList :: [Text]
varList = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\TypeDescriptor
_ Int
y -> Int -> Text
indexVar Int
y) [TypeDescriptor]
types [Int
1 ..]
    patterns :: [EPattern]
patterns = Text -> EPattern
EVarP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
varList
    getExpr :: GenM EExpr
getExpr = do
      EExpr
le <- GenM EExpr
listEncoder
      [EExpr]
expr <-
        forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
          (\TypeDescriptor
x Int
i -> do
             EExpr
expr <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr (Int
idx forall a. Num a => a -> a -> a
+ Int
1) TypeDescriptor
x
             forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
expr (Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ Int -> Text
indexVar Int
i))
          [TypeDescriptor]
types
          [Int
1 ..]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
"identity") forall a b. (a -> b) -> a -> b
$ [EExpr] -> EExpr
EList [EExpr]
expr)

generateTupleDecoder :: Int -> [TypeDescriptor] -> EDec
generateTupleDecoder :: Int -> [TypeDescriptor] -> EDec
generateTupleDecoder Int
nidx [TypeDescriptor]
types =
  Text -> FSig -> [Text] -> EExpr -> EDec
EFunc ([Text] -> Text
T.concat [Text
"decodeTuple", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
nidx]) forall a. Maybe a
Nothing [] forall a b. (a -> b) -> a -> b
$
  [EDec] -> EExpr -> EExpr
ELet [Text -> Int -> [TypeDescriptor] -> EDec
mkTupleMaker Text
mktName Int
nidx [TypeDescriptor]
types] forall a b. (a -> b) -> a -> b
$
  Text -> [EExpr] -> EExpr
aggregateDecoders Text
mktName forall a b. (a -> b) -> a -> b
$
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
    (\TypeDescriptor
t Int
idx ->
       EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.index" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ Int -> ELit
EIntL Int
idx)) forall a b. (a -> b) -> a -> b
$
       Int -> TypeDescriptor -> EExpr
getDecoderExpr (Int
nidx forall a. Num a => a -> a -> a
+ Int
1) TypeDescriptor
t)
    [TypeDescriptor]
types
    [Int
0 ..]
  where
    mktName :: Text
mktName = [Text] -> Text
T.concat [Text
"mkTuple", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
nidx]

generateElm :: GenOption -> HType -> Options -> GenM Text
generateElm :: GenOption -> HType -> Options -> GenM Text
generateElm GenOption
d HType
h Options
opts = do
  TypeDescriptor
td <- HType -> GenM TypeDescriptor
toTypeDescriptor HType
h
  TypeDescriptor -> GenM ()
collectExtRefs TypeDescriptor
td
  ElmSrc
src <-
    case GenOption
d of
      Definiton PolyConfig
Mono -> do
        EDec
def <- TypeDescriptor -> Bool -> GenM EDec
generateElmDef TypeDescriptor
td Bool
False
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> ElmSrc
ElmSrc [EDec
def]
      Definiton PolyConfig
Poly -> do
        EDec
def <- TypeDescriptor -> Bool -> GenM EDec
generateElmDef TypeDescriptor
td Bool
True
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> ElmSrc
ElmSrc [EDec
def]
      Everything PolyConfig
Mono -> do
        let decoder :: Decoder
decoder = Options -> TypeDescriptor -> Decoder
typeDescriptorToDecoder Options
opts TypeDescriptor
td
        EDec
def <- TypeDescriptor -> Bool -> GenM EDec
generateElmDef TypeDescriptor
td Bool
False
        EDec
encSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateEncoder (TypeDescriptor
td, Decoder
decoder)
        EDec
decSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateDecoder (TypeDescriptor
td, Decoder
decoder)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> ElmSrc
ElmSrc [EDec
def, EDec
encSrc, EDec
decSrc]
      Everything PolyConfig
Poly -> do
        EDec
def <- TypeDescriptor -> Bool -> GenM EDec
generateElmDef TypeDescriptor
td Bool
True
        let decoder :: Decoder
decoder = Options -> TypeDescriptor -> Decoder
typeDescriptorToDecoder Options
opts TypeDescriptor
td
        EDec
encSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateEncoder (TypeDescriptor
td, Decoder
decoder)
        EDec
decSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateDecoder (TypeDescriptor
td, Decoder
decoder)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> ElmSrc
ElmSrc [EDec
def, EDec
encSrc, EDec
decSrc]
      GenOption
EncoderDecoder -> do
        let decoder :: Decoder
decoder = Options -> TypeDescriptor -> Decoder
typeDescriptorToDecoder Options
opts TypeDescriptor
td
        EDec
encSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateEncoder (TypeDescriptor
td, Decoder
decoder)
        EDec
decSrc <- (TypeDescriptor, Decoder) -> GenM EDec
generateDecoder (TypeDescriptor
td, Decoder
decoder)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> ElmSrc
ElmSrc [EDec
encSrc, EDec
decSrc]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ElmSrc -> Text
renderElm ElmSrc
src

generateDecoder :: (TypeDescriptor, Decoder) -> GenM EDec
generateDecoder :: (TypeDescriptor, Decoder) -> GenM EDec
generateDecoder (TypeDescriptor
td, Decoder
decoder) = do
  Text
tdisplay <- TypeDescriptor -> Bool -> Bool -> GenM Text
renderType TypeDescriptor
td Bool
True Bool
True
  case TypeDescriptor
td of
    (TOccupied MData
md ReifyInfo
_ [TypeDescriptor]
_ Constructors
_) -> Text -> Text -> GenM EDec
fn (MData -> Text
_mTypeName MData
md) Text
tdisplay
    TypeDescriptor
_ -> forall a. HasCallStack => String -> a
error String
"Encoders/decoders can only be made for user defined types"
  where
    fn :: Text -> Text -> GenM EDec
    fn :: Text -> Text -> GenM EDec
fn Text
tn Text
tdisp = do
      EExpr
x <- Decoder -> GenM EExpr
decoderToDecoderEExpr Decoder
decoder
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Text -> FSig -> [Text] -> EExpr -> EDec
EFunc
          ([Text] -> Text
T.concat [Text
"decode", Text
tn])
          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"D.Decoder ", Text
tdisp])
          []
          EExpr
x

prependMk :: Text -> Text
prependMk :: Text -> Text
prependMk Text
x = [Text] -> Text
T.concat [Text
"mk", Text
x]

decoderToDecoderEExpr :: Decoder -> GenM EExpr
decoderToDecoderEExpr :: Decoder -> GenM EExpr
decoderToDecoderEExpr Decoder
d =
  case Decoder
d of
    DUnderConKey [(Text, Text, ContentDecoder)]
cds -> do
      [EExpr]
exprs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text, ContentDecoder) -> GenM EExpr
decodeUnderConKey [(Text, Text, ContentDecoder)]
cds
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.oneOf" ([EExpr] -> EExpr
EList [EExpr]
exprs)
    DTagged Text
tfn Text
cfn [(Text, Text, ContentDecoder)]
cds -> do
      EDec
tryCons <- FSig -> [(Text, Text, ContentDecoder)] -> GenM EDec
mkTryCons (forall a. a -> Maybe a
Just Text
cfn) [(Text, Text, ContentDecoder)]
cds
      let expr :: EExpr
expr =
            EExpr -> EExpr -> EExpr
EFuncApp
              (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.andThen" EExpr
"tryCons")
              (EExpr -> EExpr -> EExpr
EFuncApp
                 (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
tfn))
                 EExpr
"D.string")
       in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> EExpr -> EExpr
ELet [EDec
tryCons] EExpr
expr
    DTwoElement [(Text, Text, ContentDecoder)]
cds -> do
      EDec
tryCons <- FSig -> [(Text, Text, ContentDecoder)] -> GenM EDec
mkTryCons forall a. Maybe a
Nothing [(Text, Text, ContentDecoder)]
cds
      let expr :: EExpr
expr =
            EExpr -> EExpr -> EExpr
EFuncApp
              (EExpr -> EExpr -> EExpr
EFuncApp
                 EExpr
"D.andThen"
                 (EExpr -> EExpr -> EExpr -> EExpr
EInlineApp
                    EExpr
">>"
                    EExpr
"tryCons"
                    (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.index" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ Int -> ELit
EIntL Int
1))))
              (EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.index" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ Int -> ELit
EIntL Int
0)) EExpr
"D.string")
       in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> EExpr -> EExpr
ELet [EDec
tryCons] EExpr
expr
    DUntagged [(Text, ContentDecoder)]
cds -> do
      [EExpr]
exprs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FSig -> Text -> ContentDecoder -> GenM EExpr
contentDecoderToExp forall a. Maybe a
Nothing)) [(Text, ContentDecoder)]
cds
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.oneOf" ([EExpr] -> EExpr
EList [EExpr]
exprs)

mkTryCons :: Maybe Text -> [(ConName, ConTag, ContentDecoder)] -> GenM EDec
mkTryCons :: FSig -> [(Text, Text, ContentDecoder)] -> GenM EDec
mkTryCons FSig
mcntFname [(Text, Text, ContentDecoder)]
cds = do
  [ECaseBranch]
cbs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text, ContentDecoder) -> GenM ECaseBranch
fn1 [(Text, Text, ContentDecoder)]
cds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> FSig -> [Text] -> EExpr -> EDec
EFunc Text
"tryCons" forall a. Maybe a
Nothing [Text
"v"] forall a b. (a -> b) -> a -> b
$ EExpr -> [ECaseBranch] -> EExpr
ECase EExpr
"v" ([ECaseBranch]
cbs forall a. [a] -> [a] -> [a]
++ [ECaseBranch
emptyPattern])
  where
    emptyPattern :: ECaseBranch
emptyPattern =
      ( EPattern
EWildP
      , EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.fail" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL String
"None of the constructors match"))
    fn1 :: (ConName, ConTag, ContentDecoder) -> GenM ECaseBranch
    fn1 :: (Text, Text, ContentDecoder) -> GenM ECaseBranch
fn1 (Text
cname, Text
ctag, ContentDecoder
cd) = do
      EExpr
expression <- FSig -> Text -> ContentDecoder -> GenM EExpr
contentDecoderToExp FSig
mcntFname Text
cname ContentDecoder
cd
      let pat :: EPattern
pat = ELit -> EPattern
ELitP (String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag)
       in forall (f :: * -> *) a. Applicative f => a -> f a
pure (EPattern
pat, EExpr
expression)

decodeUnderConKey :: (ConName, ConTag, ContentDecoder) -> GenM EExpr
decodeUnderConKey :: (Text, Text, ContentDecoder) -> GenM EExpr
decodeUnderConKey (Text
cname, Text
ctag, ContentDecoder
cd) = do
  EExpr
decoderExp <- FSig -> Text -> ContentDecoder -> GenM EExpr
contentDecoderToExp forall a. Maybe a
Nothing Text
cname ContentDecoder
cd
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag)) EExpr
decoderExp

contentDecoderToExp :: Maybe Text -> ConName -> ContentDecoder -> GenM EExpr
contentDecoderToExp :: FSig -> Text -> ContentDecoder -> GenM EExpr
contentDecoderToExp FSig
mcntFname Text
cname ContentDecoder
cd =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
  case ContentDecoder
cd of
    CDRecord [(Text, Text, TypeDescriptor)]
nfds ->
      let makerFnName :: Text
makerFnName = Text -> Text
prependMk Text
cname
          makerFn :: EDec
makerFn = Text -> Text -> [(Text, Text, TypeDescriptor)] -> EDec
mkRecorderMaker Text
makerFnName Text
cname [(Text, Text, TypeDescriptor)]
nfds
       in [EDec] -> EExpr -> EExpr
ELet [EDec
makerFn] forall a b. (a -> b) -> a -> b
$ Text -> [EExpr] -> EExpr
aggregateDecoders Text
makerFnName forall a b. (a -> b) -> a -> b
$ (Text, Text, TypeDescriptor) -> EExpr
mapFn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text, TypeDescriptor)]
nfds
    CDRecordRaw nfd :: (Text, Text, TypeDescriptor)
nfd@(Text
_, Text
_, TypeDescriptor
td) ->
      let makerFnName :: Text
makerFnName = Text -> Text
prependMk Text
cname
          makerFn :: EDec
makerFn = Text -> Text -> [(Text, Text, TypeDescriptor)] -> EDec
mkRecorderMaker Text
makerFnName Text
cname [(Text, Text, TypeDescriptor)
nfd]
          agg :: EExpr
agg = Text -> [EExpr] -> EExpr
aggregateDecoders Text
makerFnName [Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
0 TypeDescriptor
td]
       in [EDec] -> EExpr -> EExpr
ELet [EDec
makerFn] forall a b. (a -> b) -> a -> b
$
          case FSig
mcntFname of
            Just Text
cntFname ->
              EExpr -> EExpr -> EExpr
EFuncApp
                (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
cntFname))
                EExpr
agg
            FSig
_ -> EExpr
agg
    CDList [TypeDescriptor]
tds ->
      let agg :: EExpr
agg = Text -> [EExpr] -> EExpr
aggregateDecoders Text
cname forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TypeDescriptor -> EExpr
zipFn [Int
0 ..] [TypeDescriptor]
tds
       in case FSig
mcntFname of
            Just Text
cntFname ->
              EExpr -> EExpr -> EExpr
EFuncApp
                (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
cntFname))
                EExpr
agg
            FSig
Nothing -> EExpr
agg
    CDRaw TypeDescriptor
td ->
      let agg :: EExpr
agg = Text -> [EExpr] -> EExpr
aggregateDecoders Text
cname [Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
0 TypeDescriptor
td]
       in case FSig
mcntFname of
            Just Text
cntFname ->
              EExpr -> EExpr -> EExpr
EFuncApp
                (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
cntFname))
                EExpr
agg
            FSig
Nothing -> EExpr
agg
    ContentDecoder
CDEmpty -> EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.succeed" (Text -> EExpr
EName Text
cname)
  where
    mapFn :: (FieldName, FieldTag, TypeDescriptor) -> EExpr
    mapFn :: (Text, Text, TypeDescriptor) -> EExpr
mapFn (Text
_, Text
ft, TypeDescriptor
td) =
      case TypeDescriptor
td of
        TMaybe TypeDescriptor
wtd ->
          EExpr -> EExpr -> EExpr
EFuncApp
            EExpr
"D.maybe"
            (EExpr -> EExpr -> EExpr
EFuncApp
               (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ft))
               (Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
0 TypeDescriptor
wtd))
        TypeDescriptor
_ ->
          EExpr -> EExpr -> EExpr
EFuncApp
            (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.field" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ft))
            (Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
0 TypeDescriptor
td)
    zipFn :: Int -> TypeDescriptor -> EExpr
    zipFn :: Int -> TypeDescriptor -> EExpr
zipFn Int
idx TypeDescriptor
td =
      EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.index" (ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ Int -> ELit
EIntL Int
idx)) (Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
0 TypeDescriptor
td)

aggregateDecoders :: Text -> [EExpr] -> EExpr
aggregateDecoders :: Text -> [EExpr] -> EExpr
aggregateDecoders Text
mfn [EExpr]
exprs =
  let fieldCount :: Int
fieldCount = forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [EExpr]
exprs
      field8 :: [EExpr]
field8 = forall a. Int -> [a] -> [a]
DL.take Int
8 [EExpr]
exprs
      field8L :: Int
field8L = forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [EExpr]
field8
      decU8 :: EExpr
decU8 =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
DL.foldl'
          EExpr -> EExpr -> EExpr
EFuncApp
          (EExpr -> EExpr -> EExpr
EFuncApp
             (Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$
              [Text] -> Text
T.concat
                [ Text
"D.map"
                , if Int
field8L forall a. Ord a => a -> a -> Bool
> Int
1
                    then String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
field8L
                    else Text
""
                ])
             (Text -> EExpr
EName Text
mfn))
          [EExpr]
field8
   in if Int
fieldCount forall a. Ord a => a -> a -> Bool
< Int
9
        then EExpr
decU8
        else forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
DL.foldl' (\EExpr
a EExpr
v -> EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"seqApp" EExpr
a) EExpr
v) EExpr
decU8 forall a b. (a -> b) -> a -> b
$
             forall a. Int -> [a] -> [a]
DL.drop Int
8 [EExpr]
exprs

mkRecorderMaker ::
     Text -> ConName -> [(FieldName, FieldTag, TypeDescriptor)] -> EDec
mkRecorderMaker :: Text -> Text -> [(Text, Text, TypeDescriptor)] -> EDec
mkRecorderMaker Text
rmName Text
cname [(Text, Text, TypeDescriptor)]
fds =
  let args :: [Text]
args = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Text, Text, TypeDescriptor)
_ Int
y -> [Text] -> Text
T.concat [Text
"a", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
y]) [(Text, Text, TypeDescriptor)]
fds [(Int
1 :: Int) ..]
   in Text -> FSig -> [Text] -> EExpr -> EDec
EFunc Text
rmName forall a. Maybe a
Nothing [Text]
args forall a b. (a -> b) -> a -> b
$
      EExpr -> EExpr -> EExpr
EFuncApp (Text -> EExpr
EName Text
cname) ([EField] -> EExpr
ERec forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, Text, TypeDescriptor) -> Text -> EField
mkField [(Text, Text, TypeDescriptor)]
fds [Text]
args)
  where
    mkField :: (FieldName, FieldTag, TypeDescriptor) -> Text -> EField
    mkField :: (Text, Text, TypeDescriptor) -> Text -> EField
mkField (Text
fn, Text
_, TypeDescriptor
_) Text
a = (Text
fn, Text -> EExpr
EName Text
a)

mkTupleMaker :: Text -> Int -> [TypeDescriptor] -> EDec
mkTupleMaker :: Text -> Int -> [TypeDescriptor] -> EDec
mkTupleMaker Text
tmName Int
idx [TypeDescriptor]
fds =
  let args :: [Text]
args =
        forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (\TypeDescriptor
_ Int
y -> [Text] -> Text
T.concat [Text
"a", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx, Text
"_", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
y])
          [TypeDescriptor]
fds
          [(Int
1 :: Int) ..]
   in Text -> FSig -> [Text] -> EExpr -> EDec
EFunc Text
tmName forall a. Maybe a
Nothing [Text]
args forall a b. (a -> b) -> a -> b
$ [EExpr] -> EExpr
ETuple (Text -> EExpr
EName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args)

generateEncoder :: (TypeDescriptor, Decoder) -> GenM EDec
generateEncoder :: (TypeDescriptor, Decoder) -> GenM EDec
generateEncoder (TypeDescriptor
td, Decoder
decoder) = do
  Text
tdisplay <- TypeDescriptor -> Bool -> Bool -> GenM Text
renderType TypeDescriptor
td Bool
False Bool
True
  case TypeDescriptor
td of
    (TOccupied MData
md ReifyInfo
_ [TypeDescriptor]
_ Constructors
_) -> Text -> Text -> GenM EDec
fn (MData -> Text
_mTypeName MData
md) Text
tdisplay
    TypeDescriptor
_ -> forall a. HasCallStack => String -> a
error String
"Encoders/decoders can only be made for user defined types"
  where
    fn :: Text -> Text -> GenM EDec
    fn :: Text -> Text -> GenM EDec
fn Text
tname Text
tdisp = do
      EExpr
expr <- Decoder -> GenM EExpr
decoderToEncoderEExpr Decoder
decoder
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Text -> FSig -> [Text] -> EExpr -> EDec
EFunc
          ([Text] -> Text
T.concat [Text
"encode", Text
tname])
          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
tdisp, Text
" -> ", Text
"E.Value"])
          [Text
"a"]
          EExpr
expr

decoderToEncoderEExpr :: Decoder -> GenM EExpr
decoderToEncoderEExpr :: Decoder -> GenM EExpr
decoderToEncoderEExpr Decoder
d =
  case Decoder
d of
    DUnderConKey [(Text, Text, ContentDecoder)]
cons_ -> do
      [ECaseBranch]
cb <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn [(Text, Text, ContentDecoder)]
cons_
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> [ECaseBranch] -> EExpr
ECase EExpr
"a" [ECaseBranch]
cb
    DTagged Text
tfn Text
cfn [(Text, Text, ContentDecoder)]
cons_ -> do
      [ECaseBranch]
expr <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Text -> (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn2 Text
tfn Text
cfn) [(Text, Text, ContentDecoder)]
cons_
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> [ECaseBranch] -> EExpr
ECase EExpr
"a" [ECaseBranch]
expr
    DTwoElement [(Text, Text, ContentDecoder)]
cons_ -> do
      [ECaseBranch]
expr <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn3 [(Text, Text, ContentDecoder)]
cons_
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> [ECaseBranch] -> EExpr
ECase EExpr
"a" [ECaseBranch]
expr
    DUntagged [(Text, ContentDecoder)]
cons_ -> do
      [ECaseBranch]
bs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, ContentDecoder) -> GenM ECaseBranch
mapFn4 [(Text, ContentDecoder)]
cons_
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> [ECaseBranch] -> EExpr
ECase EExpr
"a" [ECaseBranch]
bs
  where
    mapFn4 :: (ConName, ContentDecoder) -> GenM ECaseBranch
    mapFn4 :: (Text, ContentDecoder) -> GenM ECaseBranch
mapFn4 (Text
cname, ContentDecoder
cd) = do
      EExpr
expr <- Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp forall a. Maybe a
Nothing ContentDecoder
cd
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text, ContentDecoder) -> EPattern
makePattern (Text
cname, Text
"", ContentDecoder
cd), EExpr
expr)
    mapFn3 :: (ConName, ConTag, ContentDecoder) -> GenM ECaseBranch
    mapFn3 :: (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn3 a :: (Text, Text, ContentDecoder)
a@(Text
_, Text
ctag, ContentDecoder
cd) = do
      EExpr
exprs <- Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp forall a. Maybe a
Nothing ContentDecoder
cd
      EExpr
le <- GenM EExpr
listEncoder
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( (Text, Text, ContentDecoder) -> EPattern
makePattern (Text, Text, ContentDecoder)
a
        , EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
"identity") forall a b. (a -> b) -> a -> b
$
          [EExpr] -> EExpr
EList [EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.string" forall a b. (a -> b) -> a -> b
$ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag, EExpr
exprs])
    mapFn2 ::
         Text -> Text -> (ConName, ConTag, ContentDecoder) -> GenM ECaseBranch
    mapFn2 :: Text -> Text -> (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn2 Text
tfn Text
cfn (Text, Text, ContentDecoder)
a = do
      EExpr
expr <- Text -> Text -> (Text, Text, ContentDecoder) -> GenM EExpr
encoderTagged Text
tfn Text
cfn (Text, Text, ContentDecoder)
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text, ContentDecoder) -> EPattern
makePattern (Text, Text, ContentDecoder)
a, EExpr
expr)
    mapFn :: (ConName, ConTag, ContentDecoder) -> GenM ECaseBranch
    mapFn :: (Text, Text, ContentDecoder) -> GenM ECaseBranch
mapFn (Text, Text, ContentDecoder)
a = do
      EExpr
expr <- (Text, Text, ContentDecoder) -> GenM EExpr
encoderUnderConKey (Text, Text, ContentDecoder)
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text, ContentDecoder) -> EPattern
makePattern (Text, Text, ContentDecoder)
a, EExpr
expr)
    makePattern :: (ConName, ConTag, ContentDecoder) -> EPattern
    makePattern :: (Text, Text, ContentDecoder) -> EPattern
makePattern (Text
cname, Text
_, ContentDecoder
cd) =
      case ContentDecoder
cd of
        CDRecord [(Text, Text, TypeDescriptor)]
_ -> Text -> [EPattern] -> EPattern
EConsP Text
cname [Text -> EPattern
EVarP Text
"x"]
        CDRecordRaw (Text, Text, TypeDescriptor)
_ -> Text -> [EPattern] -> EPattern
EConsP Text
cname [Text -> EPattern
EVarP Text
"x"]
        CDList [TypeDescriptor]
tds ->
          Text -> [EPattern] -> EPattern
EConsP Text
cname forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            (\Int
x TypeDescriptor
_ -> Text -> EPattern
EVarP forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"a", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
x])
            [(Int
1 :: Int) ..]
            [TypeDescriptor]
tds
        CDRaw TypeDescriptor
_ -> Text -> [EPattern] -> EPattern
EConsP Text
cname [Text -> EPattern
EVarP Text
"a1"]
        ContentDecoder
CDEmpty -> Text -> [EPattern] -> EPattern
EConsP Text
cname []

encoderUnderConKey :: (ConName, ConTag, ContentDecoder) -> GenM EExpr
encoderUnderConKey :: (Text, Text, ContentDecoder) -> GenM EExpr
encoderUnderConKey (Text
_, Text
ctag, ContentDecoder
cd) = do
  EExpr
decoderExp <- Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp forall a. Maybe a
Nothing ContentDecoder
cd
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.object" forall a b. (a -> b) -> a -> b
$
    [EExpr] -> EExpr
EList [[EExpr] -> EExpr
ETuple [ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag, EExpr
decoderExp]]

encoderTagged :: Text -> Text -> (ConName, ConTag, ContentDecoder) -> GenM EExpr
encoderTagged :: Text -> Text -> (Text, Text, ContentDecoder) -> GenM EExpr
encoderTagged Text
tfn Text
cfn (Text
_, Text
ctag, ContentDecoder
cd) =
  case ContentDecoder
cd of
    CDRecord [(Text, Text, TypeDescriptor)]
_ -> Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp (forall a. a -> Maybe a
Just (Text
tfn, Text
ctag)) ContentDecoder
cd
    CDRecordRaw (Text, Text, TypeDescriptor)
_ -> Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp forall a. Maybe a
Nothing ContentDecoder
cd
    ContentDecoder
_ -> do
      EExpr
encExp <- Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp forall a. Maybe a
Nothing ContentDecoder
cd
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.object" forall a b. (a -> b) -> a -> b
$
        [EExpr] -> EExpr
EList
          [ [EExpr] -> EExpr
ETuple
              [ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
tfn
              , EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.string" forall a b. (a -> b) -> a -> b
$ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag
              ]
          , [EExpr] -> EExpr
ETuple [ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
cfn, EExpr
encExp]
          ]

contentDecoderToEncoderExp ::
     Maybe (FieldName, ConTag) -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp :: Maybe ExItem -> ContentDecoder -> GenM EExpr
contentDecoderToEncoderExp Maybe ExItem
mct ContentDecoder
cd =
  case ContentDecoder
cd of
    CDRecord [(Text, Text, TypeDescriptor)]
fds -> do
      [EExpr]
es <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text, TypeDescriptor) -> GenM EExpr
mapFn [(Text, Text, TypeDescriptor)]
fds
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.object" forall a b. (a -> b) -> a -> b
$
        case Maybe ExItem
mct of
          Maybe ExItem
Nothing -> [EExpr] -> EExpr
EList [EExpr]
es
          Just (Text
tn, Text
ctag) ->
            let x :: EExpr
x =
                  [EExpr] -> EExpr
ETuple
                    [ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
tn
                    , EExpr -> EExpr -> EExpr
EFuncApp EExpr
"E.string" forall a b. (a -> b) -> a -> b
$ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ctag
                    ]
             in [EExpr] -> EExpr
EList forall a b. (a -> b) -> a -> b
$ EExpr
x forall a. a -> [a] -> [a]
: [EExpr]
es
    CDRecordRaw (Text
fn, Text
_, TypeDescriptor
td) -> do
      EExpr
encoderExp <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
0 TypeDescriptor
td
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
encoderExp forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"x", Text
".", Text
fn]
    CDList [TypeDescriptor]
tds -> do
      [EExpr]
ls <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM TypeDescriptor -> Int -> GenM EExpr
zipFn [TypeDescriptor]
tds [Int
1 ..]
      EExpr
le <- GenM EExpr
listEncoder
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
"identity") forall a b. (a -> b) -> a -> b
$ [EExpr] -> EExpr
EList [EExpr]
ls
    CDRaw TypeDescriptor
td -> do
      EExpr
eexp <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
0 TypeDescriptor
td
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
eexp EExpr
"a1"
    ContentDecoder
CDEmpty -> do
      EExpr
le <- GenM EExpr
listEncoder
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
"identity") forall a b. (a -> b) -> a -> b
$ [EExpr] -> EExpr
EList []
  where
    zipFn :: TypeDescriptor -> Int -> GenM EExpr
    zipFn :: TypeDescriptor -> Int -> GenM EExpr
zipFn TypeDescriptor
td Int
idx = do
      EExpr
encodeExp <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
0 TypeDescriptor
td
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
encodeExp forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"a", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx]
    mapFn :: (FieldName, FieldTag, TypeDescriptor) -> GenM EExpr
    mapFn :: (Text, Text, TypeDescriptor) -> GenM EExpr
mapFn (Text
fn, Text
ft, TypeDescriptor
td) = do
      EExpr
encoderName <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
0 TypeDescriptor
td
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        [EExpr] -> EExpr
ETuple
          [ ELit -> EExpr
ELiteral forall a b. (a -> b) -> a -> b
$ String -> ELit
EStringL forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ft
          , EExpr -> EExpr -> EExpr
EFuncApp EExpr
encoderName forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"x", Text
".", Text
fn]
          ]

getEncoderExpr :: Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr :: Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
idx (TTuple [TypeDescriptor]
tds) = do
  EDec
expr <- Int -> [TypeDescriptor] -> GenM EDec
generateTupleEncoder Int
idx [TypeDescriptor]
tds
  EExpr
le <- GenM EExpr
listEncoder
  case [TypeDescriptor]
tds of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr
ELambda (EExpr -> EExpr -> EExpr
EFuncApp (EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
"identity") forall a b. (a -> b) -> a -> b
$ [EExpr] -> EExpr
EList [])
    (TypeDescriptor
_:[TypeDescriptor]
_) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [EDec] -> EExpr -> EExpr
ELet [EDec
expr] (Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"encodeTuple", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx])
getEncoderExpr Int
_ (TOccupied MData
md ReifyInfo
_ [TypeDescriptor]
_ Constructors
_) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"encode", MData -> Text
_mTypeName MData
md]
getEncoderExpr Int
_ (TPrimitive MData
n) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ Text -> Text
getPrimitiveEncoder forall a b. (a -> b) -> a -> b
$ MData -> Text
_mTypeName MData
n
getEncoderExpr Int
idx (TList TypeDescriptor
x) = do
  EExpr
le <- GenM EExpr
listEncoder
  EExpr
eexp <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
idx TypeDescriptor
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
le EExpr
eexp
getEncoderExpr Int
idx (TMaybe TypeDescriptor
x) = do
  EExpr
expr <- Int -> TypeDescriptor -> GenM EExpr
getEncoderExpr Int
idx TypeDescriptor
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr -> EExpr
EFuncApp EExpr
"encodeMaybe" EExpr
expr
getEncoderExpr Int
_ (TRecusrive MData
md) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"encode", MData -> Text
_mTypeName MData
md]
getEncoderExpr Int
_ (TExternal (ExInfo ExItem
_ (Just ExItem
ei) Maybe ExItem
_ [TypeDescriptor]
_)) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [forall a b. (a, b) -> b
snd ExItem
ei]
getEncoderExpr Int
_ (TExternal ExInfo {}) = forall a. HasCallStack => String -> a
error String
"Encoder not found"
getEncoderExpr Int
_ TypeDescriptor
_ = forall a. HasCallStack => String -> a
error String
"Encoder not found"

getDecoderExpr :: Int -> TypeDescriptor -> EExpr
getDecoderExpr :: Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
idx TypeDescriptor
td =
  let expr :: EExpr
expr =
        case TypeDescriptor
td of
          TEmpty {} -> forall a. HasCallStack => String -> a
error String
"Cannot decode empty types"
          TTuple [TypeDescriptor]
tds ->
            case [TypeDescriptor]
tds of
              [] -> EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.succeed" EExpr
"()"
              (TypeDescriptor
_:[TypeDescriptor]
_) ->
                [EDec] -> EExpr -> EExpr
ELet [Int -> [TypeDescriptor] -> EDec
generateTupleDecoder Int
idx [TypeDescriptor]
tds] forall a b. (a -> b) -> a -> b
$
                Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"decodeTuple", String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
idx]
          TOccupied MData
md ReifyInfo
_ [TypeDescriptor]
_ Constructors
_ -> Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"decode", MData -> Text
_mTypeName MData
md]
          TPrimitive MData
n -> Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ Text -> Text
getPrimitiveDecoder forall a b. (a -> b) -> a -> b
$ MData -> Text
_mTypeName MData
n
          TList TypeDescriptor
x -> EExpr -> EExpr -> EExpr
EFuncApp (Text -> EExpr
EName Text
"D.list") (Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
idx TypeDescriptor
x)
          TRecusrive MData
md ->
            EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.lazy" forall a b. (a -> b) -> a -> b
$
            EExpr -> EExpr
ELambda forall a b. (a -> b) -> a -> b
$ Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"decode", MData -> Text
_mTypeName MData
md]
          TMaybe TypeDescriptor
x -> (EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.nullable" (Int -> TypeDescriptor -> EExpr
getDecoderExpr Int
idx TypeDescriptor
x))
          TExternal (ExInfo ExItem
_ Maybe ExItem
_ (Just ExItem
ei) [TypeDescriptor]
_) -> Text -> EExpr
EName forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [forall a b. (a, b) -> b
snd ExItem
ei]
          TExternal ExInfo {} -> forall a. HasCallStack => String -> a
error String
"Decoder not found"
          TVar Name
_ -> forall a. HasCallStack => String -> a
error String
"Decoder not found"
   in if TypeDescriptor -> Bool
checkRecursion TypeDescriptor
td
        then EExpr -> EExpr -> EExpr
EFuncApp EExpr
"D.lazy" forall a b. (a -> b) -> a -> b
$ EExpr -> EExpr
ELambda EExpr
expr
        else EExpr
expr

checkRecursion :: TypeDescriptor -> Bool
checkRecursion :: TypeDescriptor -> Bool
checkRecursion TypeDescriptor
td_ =
  case TypeDescriptor
td_ of
    TOccupied MData
_ ReifyInfo
_ [TypeDescriptor]
_ Constructors
cnstrs -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ TypeDescriptor -> Bool
checkRecursion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constructors -> [TypeDescriptor]
getTypeDescriptors Constructors
cnstrs
    TList TypeDescriptor
td -> TypeDescriptor -> Bool
checkRecursion TypeDescriptor
td
    TMaybe TypeDescriptor
td -> TypeDescriptor -> Bool
checkRecursion TypeDescriptor
td
    TPrimitive MData
_ -> Bool
False
    TRecusrive MData
_ -> Bool
True
    TExternal ExInfo TypeDescriptor
_ -> Bool
False
    TTuple [TypeDescriptor]
tds -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ TypeDescriptor -> Bool
checkRecursion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDescriptor]
tds
    TEmpty {} -> Bool
False
    TVar Name
_ -> Bool
False
  where
    getTypeDescriptors :: Constructors -> [TypeDescriptor]
    getTypeDescriptors :: Constructors -> [TypeDescriptor]
getTypeDescriptors Constructors
ncd = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ConstructorDescriptor -> [TypeDescriptor]
getFromCd Constructors
ncd
    getFromCd :: ConstructorDescriptor -> [TypeDescriptor]
    getFromCd :: ConstructorDescriptor -> [TypeDescriptor]
getFromCd (RecordConstructor Text
_ NonEmpty (Text, TypeDescriptor)
fds) = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> b
snd NonEmpty (Text, TypeDescriptor)
fds
    getFromCd (SimpleConstructor Text
_ NonEmpty TypeDescriptor
fds) = forall a. NonEmpty a -> [a]
NE.toList NonEmpty TypeDescriptor
fds
    getFromCd (NullaryConstructor Text
_) = []

getPrimitiveDecoder :: Text -> Text
getPrimitiveDecoder :: Text -> Text
getPrimitiveDecoder Text
"String" = Text
"D.string"
getPrimitiveDecoder Text
"Int" = Text
"D.int"
getPrimitiveDecoder Text
"Float" = Text
"D.float"
getPrimitiveDecoder Text
"Bool" = Text
"D.bool"
getPrimitiveDecoder Text
s = [Text] -> Text
T.concat [Text
"encode", Text
s]

getPrimitiveEncoder :: Text -> Text
getPrimitiveEncoder :: Text -> Text
getPrimitiveEncoder Text
"String" = Text
"E.string"
getPrimitiveEncoder Text
"Int" = Text
"E.int"
getPrimitiveEncoder Text
"Float" = Text
"E.float"
getPrimitiveEncoder Text
"Bool" = Text
"E.bool"
getPrimitiveEncoder Text
s = [Text] -> Text
T.concat [Text
"encode", Text
s]

-- | Generate Elm type definitions
generateElmDef :: TypeDescriptor -> Bool -> GenM EDec
generateElmDef :: TypeDescriptor -> Bool -> GenM EDec
generateElmDef TypeDescriptor
td Bool
needPoly =
  case TypeDescriptor
td of
    TEmpty (MData Text
a Text
_ Text
_) [TypeVar]
tvars [TypeDescriptor]
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> ECons -> EDec
EType Text
a ([TypeVar] -> Bool -> [Text]
getTypeVars [TypeVar]
tvars Bool
needPoly) ECons
EEmpty
    TOccupied (MData Text
a Text
_ Text
_) (ReifyInfo [TypeVar]
tvars [Con]
cnstrs) [TypeDescriptor]
_ Constructors
c -> do
      ECons
defC <-
        if Bool
needPoly
          then case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Con]
cnstrs of
                 Just NonEmpty Con
nec -> Constructors
-> WriterT [ExItem] (ReaderT (ElmVersion, GenConfig) Q) ECons
generateElmDefC forall a b. (a -> b) -> a -> b
$ forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith Con -> ConstructorDescriptor -> ConstructorDescriptor
injectTypeVars NonEmpty Con
nec Constructors
c
                 Maybe (NonEmpty Con)
Nothing -> forall a. HasCallStack => String -> a
error String
"No constructors obtained from reify"
          else Constructors
-> WriterT [ExItem] (ReaderT (ElmVersion, GenConfig) Q) ECons
generateElmDefC Constructors
c
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> ECons -> EDec
EType Text
a ([TypeVar] -> Bool -> [Text]
getTypeVars [TypeVar]
tvars Bool
needPoly) ECons
defC
    TypeDescriptor
_ -> forall a. HasCallStack => String -> a
error String
"Can only create definitions for use defined types"

getTypeVars :: [TypeVar] -> Bool -> [Text]
getTypeVars :: [TypeVar] -> Bool -> [Text]
getTypeVars [TypeVar]
tds Bool
needPoly =
  if Bool
needPoly
    then TypeVar -> Text
renderTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVar]
tds
    else []

injectTypeVars :: Con -> ConstructorDescriptor -> ConstructorDescriptor
injectTypeVars :: Con -> ConstructorDescriptor -> ConstructorDescriptor
injectTypeVars (RecC Name
_ [VarBangType]
vbt) (RecordConstructor Text
name NonEmpty (Text, TypeDescriptor)
flds) =
  case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall a b. (a -> b) -> a -> b
$ (\(Name
_, Bang
_, Type
t) -> Type
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarBangType]
vbt of
    Just NonEmpty Type
tps -> Text -> NonEmpty (Text, TypeDescriptor) -> ConstructorDescriptor
RecordConstructor Text
name (forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith Type -> (Text, TypeDescriptor) -> (Text, TypeDescriptor)
zipFn NonEmpty Type
tps NonEmpty (Text, TypeDescriptor)
flds)
    Maybe (NonEmpty Type)
Nothing -> forall a. HasCallStack => String -> a
error String
"Non empty fields expected"
  where
    zipFn :: Type -> (Text, TypeDescriptor) -> (Text, TypeDescriptor)
    zipFn :: Type -> (Text, TypeDescriptor) -> (Text, TypeDescriptor)
zipFn Type
typ (Text
n, TypeDescriptor
td) = (Text
n, Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
typ TypeDescriptor
td)
injectTypeVars (NormalC Name
_ [BangType]
bt) (SimpleConstructor Text
name NonEmpty TypeDescriptor
flds) =
  case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BangType]
bt of
    Just NonEmpty Type
tps -> Text -> NonEmpty TypeDescriptor -> ConstructorDescriptor
SimpleConstructor Text
name (forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD NonEmpty Type
tps NonEmpty TypeDescriptor
flds)
    Maybe (NonEmpty Type)
Nothing -> forall a. HasCallStack => String -> a
error String
"Non empty fields expected"
injectTypeVars Con
_ n :: ConstructorDescriptor
n@(NullaryConstructor Text
_) = ConstructorDescriptor
n
injectTypeVars Con
_ ConstructorDescriptor
_ = forall a. HasCallStack => String -> a
error String
"Constructor mismatch"

injectTypeVarIntoTD :: Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD :: Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD (VarT Name
n) TypeDescriptor
_ = Name -> TypeDescriptor
TVar Name
n
injectTypeVarIntoTD (AppT Type
t1 Type
t2) TypeDescriptor
td =
  case TypeDescriptor
td of
    TEmpty MData
md [TypeVar]
tvr [TypeDescriptor]
tds ->
      let tailTd :: TypeDescriptor
tailTd = Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 (forall a. [a] -> a
Prelude.last [TypeDescriptor]
tds)
          TEmpty MData
_ [TypeVar]
_ [TypeDescriptor]
newtds =
            Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t1 (MData -> [TypeVar] -> [TypeDescriptor] -> TypeDescriptor
TEmpty MData
md [TypeVar]
tvr (forall a. [a] -> [a]
Prelude.init [TypeDescriptor]
tds))
       in MData -> [TypeVar] -> [TypeDescriptor] -> TypeDescriptor
TEmpty MData
md [TypeVar]
tvr forall a b. (a -> b) -> a -> b
$ [TypeDescriptor]
newtds forall a. [a] -> [a] -> [a]
++ [TypeDescriptor
tailTd]
    TOccupied MData
md ReifyInfo
ri [TypeDescriptor]
tds Constructors
cnstrs ->
      let tailTd :: TypeDescriptor
tailTd = Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 (forall a. [a] -> a
Prelude.last [TypeDescriptor]
tds)
          TOccupied MData
_ ReifyInfo
_ [TypeDescriptor]
newtds Constructors
_ =
            Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t1 (MData
-> ReifyInfo -> [TypeDescriptor] -> Constructors -> TypeDescriptor
TOccupied MData
md ReifyInfo
ri (forall a. [a] -> [a]
Prelude.init [TypeDescriptor]
tds) Constructors
cnstrs)
       in MData
-> ReifyInfo -> [TypeDescriptor] -> Constructors -> TypeDescriptor
TOccupied MData
md ReifyInfo
ri ([TypeDescriptor]
newtds forall a. [a] -> [a] -> [a]
++ [TypeDescriptor
tailTd]) Constructors
cnstrs
    TTuple [TypeDescriptor]
tds ->
      let TTuple [TypeDescriptor]
newtds = Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t1 ([TypeDescriptor] -> TypeDescriptor
TTuple forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
Prelude.init [TypeDescriptor]
tds)
          tailTd :: TypeDescriptor
tailTd = Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 (forall a. [a] -> a
Prelude.last [TypeDescriptor]
tds)
       in [TypeDescriptor] -> TypeDescriptor
TTuple ([TypeDescriptor]
newtds forall a. [a] -> [a] -> [a]
++ [TypeDescriptor
tailTd])
    TExternal ExInfo TypeDescriptor
ei ->
      let tds :: [TypeDescriptor]
tds = forall a. ExInfo a -> [a]
exTypeArgs ExInfo TypeDescriptor
ei
          tailTd :: TypeDescriptor
tailTd = Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 (forall a. [a] -> a
Prelude.last [TypeDescriptor]
tds)
          TExternal ExInfo {exTypeArgs :: forall a. ExInfo a -> [a]
exTypeArgs = [TypeDescriptor]
newTds} =
            Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD
              Type
t1
              (ExInfo TypeDescriptor -> TypeDescriptor
TExternal forall a b. (a -> b) -> a -> b
$ ExInfo TypeDescriptor
ei {exTypeArgs :: [TypeDescriptor]
exTypeArgs = forall a. [a] -> [a]
Prelude.init [TypeDescriptor]
tds})
       in ExInfo TypeDescriptor -> TypeDescriptor
TExternal forall a b. (a -> b) -> a -> b
$ ExInfo TypeDescriptor
ei {exTypeArgs :: [TypeDescriptor]
exTypeArgs = [TypeDescriptor]
newTds forall a. [a] -> [a] -> [a]
++ [TypeDescriptor
tailTd]}
    TMaybe TypeDescriptor
tdc -> TypeDescriptor -> TypeDescriptor
TMaybe forall a b. (a -> b) -> a -> b
$ Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 TypeDescriptor
tdc
    TList TypeDescriptor
tdc -> TypeDescriptor -> TypeDescriptor
TList forall a b. (a -> b) -> a -> b
$ Type -> TypeDescriptor -> TypeDescriptor
injectTypeVarIntoTD Type
t2 TypeDescriptor
tdc
    TypeDescriptor
td_ -> TypeDescriptor
td_
injectTypeVarIntoTD Type
_ TypeDescriptor
td = TypeDescriptor
td

generateElmDefC :: Constructors -> GenM ECons
generateElmDefC :: Constructors
-> WriterT [ExItem] (ReaderT (ElmVersion, GenConfig) Q) ECons
generateElmDefC Constructors
cds = do
  [ECons]
cDefs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ConstructorDescriptor
-> WriterT [ExItem] (ReaderT (ElmVersion, GenConfig) Q) ECons
generateElmDefCD forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList Constructors
cds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [ECons] -> ECons
ESum [ECons]
cDefs

generateElmDefCD :: ConstructorDescriptor -> GenM ECons
generateElmDefCD :: ConstructorDescriptor
-> WriterT [ExItem] (ReaderT (ElmVersion, GenConfig) Q) ECons
generateElmDefCD ConstructorDescriptor
cd =
  case ConstructorDescriptor
cd of
    RecordConstructor Text
cname NonEmpty (Text, TypeDescriptor)
nfs -> do
      [ExItem]
rfs <- NonEmpty (Text, TypeDescriptor) -> GenM [ExItem]
generateRecordFields NonEmpty (Text, TypeDescriptor)
nfs
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [ExItem] -> ECons
ERecord Text
cname [ExItem]
rfs
    SimpleConstructor Text
cname NonEmpty TypeDescriptor
fs -> do
      [Text]
rfs <- NonEmpty TypeDescriptor -> GenM [Text]
generateUnNamedFields NonEmpty TypeDescriptor
fs
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> ECons
EProduct Text
cname [Text]
rfs
    NullaryConstructor Text
cname -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ECons
ENullary Text
cname

generateRecordFields :: NE.NonEmpty (Text, TypeDescriptor) -> GenM [ENamedField]
generateRecordFields :: NonEmpty (Text, TypeDescriptor) -> GenM [ExItem]
generateRecordFields NonEmpty (Text, TypeDescriptor)
fs =
  case NonEmpty (Text, TypeDescriptor)
fs of
    ((Text, TypeDescriptor)
nf :| []) -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, TypeDescriptor) -> GenM ExItem
mapFn [(Text, TypeDescriptor)
nf]
    NonEmpty (Text, TypeDescriptor)
n -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, TypeDescriptor) -> GenM ExItem
mapFn forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Text, TypeDescriptor)
n
  where
    mapFn :: (Text, TypeDescriptor) -> GenM ENamedField
    mapFn :: (Text, TypeDescriptor) -> GenM ExItem
mapFn (Text
a, TypeDescriptor
b) = do
      Text
x <- TypeDescriptor -> Bool -> Bool -> GenM Text
renderType TypeDescriptor
b Bool
False Bool
False
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a, Text
x)

generateUnNamedFields :: NE.NonEmpty TypeDescriptor -> GenM [Text]
generateUnNamedFields :: NonEmpty TypeDescriptor -> GenM [Text]
generateUnNamedFields NonEmpty TypeDescriptor
fds = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\TypeDescriptor
x -> TypeDescriptor -> Bool -> Bool -> GenM Text
renderType TypeDescriptor
x Bool
True Bool
False) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty TypeDescriptor
fds