{-# OPTIONS_GHC -Wno-type-defaults #-}

module Data.Registry.Aeson.TH.Decoder where

import Control.Monad.Fail
import Data.List (nub)
import Data.Registry.Aeson.TH.ThOptions
import Data.Registry.Aeson.TH.TH
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Protolude as P hiding (Type)

{-
  This module uses TemplateHaskell to extract enough type information to be able to
  build a Decoder based on configuration options
-}

-- | Make an Encoder for a given data type
--   Usage: $(makeDecoder ''MyDataType <: otherEncoders)
makeDecoder :: Name -> ExpQ
makeDecoder :: Name -> ExpQ
makeDecoder = ThOptions -> Name -> ExpQ
makeDecoderWith ThOptions
defaultThOptions

-- | Make an Encoder for a given data type, where all types names are qualified with their module full name
--    -- MyDataType is defined in X.Y.Z
--    import X.Y.Z qualified
--    $(makeDecoderQualified ''MyDataType <: otherEncoders)
makeDecoderQualified :: Name -> ExpQ
makeDecoderQualified :: Name -> ExpQ
makeDecoderQualified = ThOptions -> Name -> ExpQ
makeDecoderWith ((Text -> Text) -> ThOptions
ThOptions Text -> Text
qualified)

-- | Make an Encoder for a given data type, where all types names are qualified with their module name
--    -- MyDataType is defined in X.Y.Z
--    import X.Y.Z qualified as Z
--    $(makeDecoderQualifiedLast ''MyDataType <: otherEncoders)
makeDecoderQualifiedLast :: Name -> ExpQ
makeDecoderQualifiedLast :: Name -> ExpQ
makeDecoderQualifiedLast = ThOptions -> Name -> ExpQ
makeDecoderWith ((Text -> Text) -> ThOptions
ThOptions Text -> Text
qualifyWithLastName)

-- | Make a Decoder for a given data type and pass options to specify how names must be qualified
--   Usage: $(makeDecoderWith options ''MyDataType <: otherDecoders)
makeDecoderWith :: ThOptions -> Name -> ExpQ
makeDecoderWith :: ThOptions -> Name -> ExpQ
makeDecoderWith ThOptions
thOptions Name
typeName = ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"fun") (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ do
  Info
info <- Name -> Q Info
reify Name
typeName
  case Info
info of
    TyConI (NewtypeD Cxt
_context Name
_name [TyVarBndr ()]
_typeVars Maybe Type
_kind Con
constructor [DerivClause]
_deriving) ->
      ThOptions -> Name -> [Con] -> ExpQ
makeConstructorsDecoder ThOptions
thOptions Name
typeName [Con
constructor]
    TyConI (DataD Cxt
_context Name
_name [TyVarBndr ()]
_typeVars Maybe Type
_kind [Con]
constructors [DerivClause]
_deriving) -> do
      case [Con]
constructors of
        [] -> do
          Bool -> String -> Q ()
forall (m :: * -> *). Quasi m => Bool -> String -> m ()
qReport Bool
True String
"can not make an Decoder for an empty data type"
          String -> ExpQ
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoders creation failed"
        [Con]
_ -> ThOptions -> Name -> [Con] -> ExpQ
makeConstructorsDecoder ThOptions
thOptions Name
typeName [Con]
constructors
    Info
other -> do
      Bool -> String -> Q ()
forall (m :: * -> *). Quasi m => Bool -> String -> m ()
qReport Bool
True (String
"can only create decoders for an ADT, got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Info -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Info
other)
      String -> ExpQ
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decoders creation failed"

-- | Make a decoder for a given data type by extracting just enough metadata about the data type in order to be able
--   to parse a Value
--
--   For example for the data type:
--
--   data T = T1 {f1::Int, f2::Int} | T2 Int Int
--
--   we add this function to the registry:
--
--   \opts d1 d2 d3 -> Decoder $ \v ->
--     decodeFromDefinitions opts v $ \case
--       ToConstructor "T1" [v1, v2]-> T1 <$> d1 v1 <*> d2 v2 ...
--       ToConstructor "T2" [v1, v2]-> T2 <$> d1 v1 <*> d3 v2 ...
--       other -> Left ("cannot decode " <> valueToText v)
--
--   The \case function is the only one which needs to be generated in order to match the exact shape of the
--   constructors to instantiate
makeConstructorsDecoder :: ThOptions -> Name -> [Con] -> ExpQ
makeConstructorsDecoder :: ThOptions -> Name -> [Con] -> ExpQ
makeConstructorsDecoder ThOptions
thOptions Name
typeName [Con]
cs = do
  Cxt
ts <- Cxt -> Cxt
forall a. Eq a => [a] -> [a]
nub (Cxt -> Cxt) -> ([Cxt] -> Cxt) -> [Cxt] -> Cxt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cxt] -> Cxt
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([Cxt] -> Cxt) -> Q [Cxt] -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Con] -> (Con -> Q Cxt) -> Q [Cxt]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Con]
cs Con -> Q Cxt
typesOf
  let decoderParameters :: [Q Pat]
decoderParameters = Q Pat -> Q Type -> Q Pat
forall (m :: * -> *). Quote m => m Pat -> m Type -> m Pat
sigP (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"os")) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Options") Q Pat -> [Q Pat] -> [Q Pat]
forall a. a -> [a] -> [a]
: Q Pat -> Q Type -> Q Pat
forall (m :: * -> *). Quote m => m Pat -> m Type -> m Pat
sigP (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"cd")) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"ConstructorsDecoder") Q Pat -> [Q Pat] -> [Q Pat]
forall a. a -> [a] -> [a]
: ((\(Type
t, Integer
n) -> Q Pat -> Q Type -> Q Pat
forall (m :: * -> *). Quote m => m Pat -> m Type -> m Pat
sigP (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"d" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Integer
n)) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Decoder") (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t))) ((Type, Integer) -> Q Pat) -> [(Type, Integer)] -> [Q Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cxt -> [Integer] -> [(Type, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip Cxt
ts [Integer
0 ..])
  -- makeToConstructors os [Constructor "T1" ["f1", "f2"], Constructor "T2" []] v
  let paramP :: Q Pat
paramP = Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"v")
  [Exp]
constructorDefs <- [Con] -> (Con -> ExpQ) -> Q [Exp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Con]
cs ((Con -> ExpQ) -> Q [Exp]) -> (Con -> ExpQ) -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ \Con
c -> do
    Name
cName <- ThOptions -> Name -> Name
makeName ThOptions
thOptions (Name -> Name) -> Q Name -> Q Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Con -> Q Name
nameOf Con
c
    [ExpQ]
fields <- (Name -> ExpQ) -> [Name] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> (Name -> Lit) -> Name -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Name -> String) -> Name -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show (Name -> String) -> (Name -> Name) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThOptions -> Name -> Name
makeName ThOptions
thOptions) ([Name] -> [ExpQ]) -> Q [Name] -> Q [ExpQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Con -> Q [Name]
fieldsOf Con
c
    [ExpQ]
fieldTypes <- (Type -> ExpQ) -> Cxt -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> (Type -> Lit) -> Type -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Type -> String) -> Type -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show (Name -> String) -> (Type -> Name) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThOptions -> Type -> Name
getSimpleTypeName ThOptions
thOptions) (Cxt -> [ExpQ]) -> Q Cxt -> Q [ExpQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Con -> Q Cxt
typesOf Con
c
    Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"makeConstructorDef") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> (String -> Lit) -> String -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> ExpQ) -> String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Name
cName) ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [ExpQ]
fields ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [ExpQ]
fieldTypes
  let matchClauses :: [Q Match]
matchClauses = ThOptions -> Name -> Cxt -> Con -> Q Match
makeMatchClause ThOptions
thOptions Name
typeName Cxt
ts (Con -> Q Match) -> [Con] -> [Q Match]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Con]
cs
  let matchFunction :: ExpQ
matchFunction = [Q Match] -> ExpQ
forall (m :: * -> *). Quote m => [m Match] -> m Exp
lamCaseE ([Q Match]
matchClauses [Q Match] -> [Q Match] -> [Q Match]
forall a. Semigroup a => a -> a -> a
<> [Name -> Q Match
makeErrorClause Name
typeName])
  let resolveFunction :: ExpQ
resolveFunction = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"decodeFromDefinitions") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"os") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"cd") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE (Exp -> ExpQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> ExpQ) -> [Exp] -> [ExpQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp]
constructorDefs) ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"v") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` ExpQ
matchFunction
  [Q Pat] -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [Q Pat]
decoderParameters (ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
conE (String -> Name
mkName String
"Decoder")) ([Q Pat] -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [Q Pat
paramP] ExpQ
resolveFunction))

-- | Decode the nth constructor of a data type
--    ToConstructor "T1" [v1, v2]-> T1 <$> d1 v1 <*> d2 v2 ...
makeMatchClause :: ThOptions -> Name -> [Type] -> Con -> MatchQ
makeMatchClause :: ThOptions -> Name -> Cxt -> Con -> Q Match
makeMatchClause ThOptions
thOptions Name
typeName Cxt
allTypes Con
c = do
  Cxt
ts <- Con -> Q Cxt
typesOf Con
c
  [(Int, Int)]
constructorTypes <- ((Type, Int, Int) -> (Int, Int))
-> [(Type, Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Type
_,Int
n,Int
k) -> (Int
n, Int
k)) ([(Type, Int, Int)] -> [(Int, Int)])
-> Q [(Type, Int, Int)] -> Q [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cxt -> Cxt -> Q [(Type, Int, Int)]
indexConstructorTypes Cxt
allTypes Cxt
ts
  Name
cName <- ThOptions -> Name -> Name
makeName ThOptions
thOptions (Name -> Name) -> Q Name -> Q Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Con -> Q Name
nameOf Con
c
  let fieldsP :: Q Pat
fieldsP = [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
forall a b. (a -> b) -> a -> b
$ (\(Int
n, Int
_) -> Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String
"v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Int
n)) ((Int, Int) -> Q Pat) -> [(Int, Int)] -> [Q Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Int)]
constructorTypes
  Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match
    (Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"ToConstructor") [Lit -> Q Pat
forall (m :: * -> *). Quote m => Lit -> m Pat
litP (String -> Lit
StringL (String -> Lit) -> (Name -> String) -> Name -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show (Name -> Lit) -> Name -> Lit
forall a b. (a -> b) -> a -> b
$ Name
cName), Q Pat
fieldsP])
    (ExpQ -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (ThOptions -> Name -> Name -> [(Int, Int)] -> ExpQ
applyDecoder ThOptions
thOptions Name
typeName Name
cName [(Int, Int)]
constructorTypes))
    []

-- | Return an error the json value cannot be decoded with a constructor name and some values
makeErrorClause :: Name -> MatchQ
makeErrorClause :: Name -> Q Match
makeErrorClause Name
typeName = do
  let errorMessage :: ExpQ
errorMessage =
        (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"<>") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
StringL (String
"cannot use this constructor to create an instance of type '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Name
typeName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': ")))
          ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"show") ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"_1"))
  Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Name -> Q Pat) -> Name -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"_1") (ExpQ -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Left") ExpQ
errorMessage)) []

-- ConstructorName <$> decodeFieldValue d1 o1 <*> decodeFieldValue d2 o2 ...
applyDecoder :: ThOptions -> Name -> Name -> [(Int, Int)] -> ExpQ
applyDecoder :: ThOptions -> Name -> Name -> [(Int, Int)] -> ExpQ
applyDecoder ThOptions
_thOptions Name
_typeName Name
cName [] = ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"pure") (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
cName)
applyDecoder ThOptions
thOptions Name
typeName Name
cName ((Int, Int)
nk : [(Int, Int)]
nks) = do
  let cons :: ExpQ
cons = ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"pure") (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
cName)
  ((Int, Int) -> ExpQ -> ExpQ) -> ExpQ -> [(Int, Int)] -> ExpQ
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int, Int)
i ExpQ
r -> ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"ap")) ExpQ
r) (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> ExpQ
decodeAt (Int, Int)
i) (ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"ap")) ExpQ
cons) (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> ExpQ
decodeAt (Int, Int)
nk) ([(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
reverse [(Int, Int)]
nks)
  where
    decodeAt :: (Int, Int) -> ExpQ
decodeAt (Int
n, Int
k) =
      Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"decodeFieldValue")
        ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName (String
"d" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Int
k))
        ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> (Name -> Lit) -> Name -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Name -> String) -> Name -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show (Name -> String) -> (Name -> Name) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThOptions -> Name -> Name
makeName ThOptions
thOptions (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ Name
typeName)
        ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` (Lit -> ExpQ
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> ExpQ) -> (Name -> Lit) -> Name -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Name -> String) -> Name -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show (Name -> String) -> (Name -> Name) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThOptions -> Name -> Name
makeName ThOptions
thOptions (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ Name
cName)
        ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName (String
"v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show Int
n))