module System.Process.Quick.CallSpec.Subcases where

import Control.Monad.Writer.Strict
import System.Process.Quick.CallArgument
import System.Process.Quick.CallSpec
import Data.HList
import Language.Haskell.TH as TH
import System.Process.Quick.Prelude hiding (show)
import Text.Show (Show (show))

newtype DcName = DcName { DcName -> String
unDcName :: String } deriving (Int -> DcName -> ShowS
[DcName] -> ShowS
DcName -> String
(Int -> DcName -> ShowS)
-> (DcName -> String) -> ([DcName] -> ShowS) -> Show DcName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DcName -> ShowS
showsPrec :: Int -> DcName -> ShowS
$cshow :: DcName -> String
show :: DcName -> String
$cshowList :: [DcName] -> ShowS
showList :: [DcName] -> ShowS
Show, DcName -> DcName -> Bool
(DcName -> DcName -> Bool)
-> (DcName -> DcName -> Bool) -> Eq DcName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DcName -> DcName -> Bool
== :: DcName -> DcName -> Bool
$c/= :: DcName -> DcName -> Bool
/= :: DcName -> DcName -> Bool
Eq, Eq DcName
Eq DcName =>
(DcName -> DcName -> Ordering)
-> (DcName -> DcName -> Bool)
-> (DcName -> DcName -> Bool)
-> (DcName -> DcName -> Bool)
-> (DcName -> DcName -> Bool)
-> (DcName -> DcName -> DcName)
-> (DcName -> DcName -> DcName)
-> Ord DcName
DcName -> DcName -> Bool
DcName -> DcName -> Ordering
DcName -> DcName -> DcName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DcName -> DcName -> Ordering
compare :: DcName -> DcName -> Ordering
$c< :: DcName -> DcName -> Bool
< :: DcName -> DcName -> Bool
$c<= :: DcName -> DcName -> Bool
<= :: DcName -> DcName -> Bool
$c> :: DcName -> DcName -> Bool
> :: DcName -> DcName -> Bool
$c>= :: DcName -> DcName -> Bool
>= :: DcName -> DcName -> Bool
$cmax :: DcName -> DcName -> DcName
max :: DcName -> DcName -> DcName
$cmin :: DcName -> DcName -> DcName
min :: DcName -> DcName -> DcName
Ord, Typeable DcName
Typeable DcName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DcName -> c DcName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DcName)
-> (DcName -> Constr)
-> (DcName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DcName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DcName))
-> ((forall b. Data b => b -> b) -> DcName -> DcName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DcName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DcName -> r)
-> (forall u. (forall d. Data d => d -> u) -> DcName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DcName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DcName -> m DcName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DcName -> m DcName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DcName -> m DcName)
-> Data DcName
DcName -> Constr
DcName -> DataType
(forall b. Data b => b -> b) -> DcName -> DcName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DcName -> u
forall u. (forall d. Data d => d -> u) -> DcName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DcName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DcName -> c DcName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DcName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DcName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DcName -> c DcName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DcName -> c DcName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DcName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DcName
$ctoConstr :: DcName -> Constr
toConstr :: DcName -> Constr
$cdataTypeOf :: DcName -> DataType
dataTypeOf :: DcName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DcName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DcName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DcName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DcName)
$cgmapT :: (forall b. Data b => b -> b) -> DcName -> DcName
gmapT :: (forall b. Data b => b -> b) -> DcName -> DcName
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DcName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DcName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DcName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DcName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DcName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DcName -> m DcName
Data, String -> DcName
(String -> DcName) -> IsString DcName
forall a. (String -> a) -> IsString a
$cfromString :: String -> DcName
fromString :: String -> DcName
IsString)

data Subcase where
  Subcase ::
    forall l.
    ( FoldrConstr l (Maybe VarBangType)
    , FoldrConstr l Exp
    , Show (HList l)
    ) => DcName -> HList l -> Subcase

instance Show Subcase where
  show :: Subcase -> String
show (Subcase DcName
dc HList l
l) = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Subcase (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DcName -> String
forall a. Show a => a -> String
show DcName
dc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HList l -> String
forall a. Show a => a -> String
show HList l
l

newtype TcName = TcName { TcName -> String
unTcName :: String } deriving (Int -> TcName -> ShowS
[TcName] -> ShowS
TcName -> String
(Int -> TcName -> ShowS)
-> (TcName -> String) -> ([TcName] -> ShowS) -> Show TcName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TcName -> ShowS
showsPrec :: Int -> TcName -> ShowS
$cshow :: TcName -> String
show :: TcName -> String
$cshowList :: [TcName] -> ShowS
showList :: [TcName] -> ShowS
Show, TcName -> TcName -> Bool
(TcName -> TcName -> Bool)
-> (TcName -> TcName -> Bool) -> Eq TcName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TcName -> TcName -> Bool
== :: TcName -> TcName -> Bool
$c/= :: TcName -> TcName -> Bool
/= :: TcName -> TcName -> Bool
Eq, Eq TcName
Eq TcName =>
(TcName -> TcName -> Ordering)
-> (TcName -> TcName -> Bool)
-> (TcName -> TcName -> Bool)
-> (TcName -> TcName -> Bool)
-> (TcName -> TcName -> Bool)
-> (TcName -> TcName -> TcName)
-> (TcName -> TcName -> TcName)
-> Ord TcName
TcName -> TcName -> Bool
TcName -> TcName -> Ordering
TcName -> TcName -> TcName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TcName -> TcName -> Ordering
compare :: TcName -> TcName -> Ordering
$c< :: TcName -> TcName -> Bool
< :: TcName -> TcName -> Bool
$c<= :: TcName -> TcName -> Bool
<= :: TcName -> TcName -> Bool
$c> :: TcName -> TcName -> Bool
> :: TcName -> TcName -> Bool
$c>= :: TcName -> TcName -> Bool
>= :: TcName -> TcName -> Bool
$cmax :: TcName -> TcName -> TcName
max :: TcName -> TcName -> TcName
$cmin :: TcName -> TcName -> TcName
min :: TcName -> TcName -> TcName
Ord, Typeable TcName
Typeable TcName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TcName -> c TcName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TcName)
-> (TcName -> Constr)
-> (TcName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TcName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcName))
-> ((forall b. Data b => b -> b) -> TcName -> TcName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TcName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TcName -> r)
-> (forall u. (forall d. Data d => d -> u) -> TcName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TcName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TcName -> m TcName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcName -> m TcName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcName -> m TcName)
-> Data TcName
TcName -> Constr
TcName -> DataType
(forall b. Data b => b -> b) -> TcName -> TcName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TcName -> u
forall u. (forall d. Data d => d -> u) -> TcName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcName -> c TcName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcName -> c TcName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcName -> c TcName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcName
$ctoConstr :: TcName -> Constr
toConstr :: TcName -> Constr
$cdataTypeOf :: TcName -> DataType
dataTypeOf :: TcName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcName)
$cgmapT :: (forall b. Data b => b -> b) -> TcName -> TcName
gmapT :: (forall b. Data b => b -> b) -> TcName -> TcName
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TcName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TcName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TcName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TcName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TcName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcName -> m TcName
Data, String -> TcName
(String -> TcName) -> IsString TcName
forall a. (String -> a) -> IsString a
$cfromString :: String -> TcName
fromString :: String -> TcName
IsString)

data Subcases
  = Subcases
    { Subcases -> TcName
tcName :: TcName
    , Subcases -> [Subcase]
subcases :: [Subcase]
    } deriving (Int -> Subcases -> ShowS
[Subcases] -> ShowS
Subcases -> String
(Int -> Subcases -> ShowS)
-> (Subcases -> String) -> ([Subcases] -> ShowS) -> Show Subcases
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Subcases -> ShowS
showsPrec :: Int -> Subcases -> ShowS
$cshow :: Subcases -> String
show :: Subcases -> String
$cshowList :: [Subcases] -> ShowS
showList :: [Subcases] -> ShowS
Show)

subcaseToRecC :: Subcase -> QR TH.Con
subcaseToRecC :: Subcase -> QR Con
subcaseToRecC (Subcase (DcName String
dcName) HList l
l) = do
  fields <- QR [VarBangType] -> QR [QR VarBangType]
forall (m :: * -> *) a. Monad m => m [a] -> m [m a]
seqA (QR [VarBangType] -> QR [QR VarBangType])
-> QR [VarBangType] -> QR [QR VarBangType]
forall a b. (a -> b) -> a -> b
$ [Maybe VarBangType] -> [VarBangType]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe VarBangType] -> [VarBangType])
-> QR [Maybe VarBangType] -> QR [VarBangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QR (Maybe VarBangType)] -> QR [Maybe VarBangType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Fun CallArgumentGen (QR (Maybe VarBangType))
-> HList l -> [QR (Maybe VarBangType)]
forall (m :: * -> *) f (l :: [*]) e.
(Monad m, HMapOut f l (m e)) =>
f -> HList l -> [m e]
hMapM Fun CallArgumentGen (QR (Maybe VarBangType))
fieldDef HList l
l)
  recC (mkName dcName) fields
  where
    fieldDef :: Fun CallArgumentGen (QR (Maybe VarBangType))
fieldDef = (forall a.
 FunCxt CallArgumentGen a =>
 a -> FunApp (QR (Maybe VarBangType)) a)
-> Fun CallArgumentGen (QR (Maybe VarBangType))
forall k1 k2 (cxt :: k1) (getb :: k2).
(forall a. FunCxt cxt a => a -> FunApp getb a) -> Fun cxt getb
Fun a -> FunApp (QR (Maybe VarBangType)) a
a -> QR (Maybe VarBangType)
forall a.
FunCxt CallArgumentGen a =>
a -> FunApp (QR (Maybe VarBangType)) a
forall a. CallArgumentGen a => a -> QR (Maybe VarBangType)
fieldExpr :: Fun CallArgumentGen (QR (Maybe VarBangType))

subcasesToDec :: Name -> [Subcase] -> QR Dec
subcasesToDec :: Name -> [Subcase] -> QR Dec
subcasesToDec Name
tyCon [Subcase]
cases = do
  Name -> [QR Con] -> [QR DerivClause] -> QR Dec
forall (m :: * -> *).
Quote m =>
Name -> [m Con] -> [m DerivClause] -> m Dec
dataD'
    Name
tyCon
    ((Subcase -> QR Con) -> [Subcase] -> [QR Con]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Subcase -> QR Con
subcaseToRecC [Subcase]
cases)
    [Maybe DerivStrategy -> [QR Pred] -> QR DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Pred] -> m DerivClause
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [[t|Data|], [t|Generic|], [t|Show|], [t|Eq|]]]

subcaseToClause :: Subcase -> QR Clause
subcaseToClause :: Subcase -> QR Clause
subcaseToClause (Subcase (DcName String
dcName) HList l
l) = do
  x <- String -> QR Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
  f <- [| concat . flap $(listE (hMapM (Fun progArgExpr :: Fun CallArgumentGen (QR Exp)) l)) |]
  pure $ Clause
    [AsP x (RecP (mkName dcName) [])]
    (NormalB (AppE f (VarE x)))
    []

instance CallArgumentGen Subcases where
  cArgName :: Subcases -> Maybe String
cArgName = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Subcases -> String) -> Subcases -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
mapFirst Char -> Char
toLower ShowS -> (Subcases -> String) -> Subcases -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcName -> String
unTcName (TcName -> String) -> (Subcases -> TcName) -> Subcases -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subcases -> TcName
tcName
  progArgExpr :: Subcases -> QR Exp
progArgExpr (Subcases (TcName String
tyCon) [Subcase]
cases) = do
    [Dec] -> QR ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Dec] -> QR ()) -> QR [Dec] -> QR ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [QR Dec] -> QR [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Name -> [Subcase] -> QR Dec
subcasesToDec (String -> Name
mkName String
tyCon) [Subcase]
cases
                      , Name -> QR Dec
genArbitraryInstance (String -> Name
mkName String
tyCon)
                      ]
    [| $([QR Clause] -> QR Exp
forall (m :: * -> *). Quote m => [m Clause] -> m Exp
lamCasesE (Subcase -> QR Clause
subcaseToClause (Subcase -> QR Clause) -> [Subcase] -> [QR Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Subcase]
cases)) . $(Name -> QR Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> QR Exp) -> (String -> Name) -> String -> QR Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> QR Exp) -> String -> QR Exp
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
mapFirst Char -> Char
toLower String
tyCon) |]


  fieldExpr :: Subcases -> QR (Maybe VarBangType)
fieldExpr (Subcases (TcName String
tyCon) [Subcase]
_) =
    Maybe VarBangType -> QR (Maybe VarBangType)
forall a. a -> QR a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VarBangType -> QR (Maybe VarBangType))
-> Maybe VarBangType -> QR (Maybe VarBangType)
forall a b. (a -> b) -> a -> b
$ VarBangType -> Maybe VarBangType
forall a. a -> Maybe a
Just ( String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
mapFirst Char -> Char
toLower String
tyCon
                , Bang
defaultBang
                , Name -> Pred
ConT (Name -> Pred) -> Name -> Pred
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
tyCon
                )