{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Tedious.Parser where

import Control.Lens (declareLensesWith, lensRules)
import Control.Lens qualified as L
import Control.Monad (join, when)
import Control.Monad.Cont (MonadCont (..), evalContT)
import Control.Monad.Trans (lift)
import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToEncoding, genericToJSON)
import Data.Aeson qualified as A
import Data.Char (isAlphaNum, isLowerCase, isPrint, isUpperCase)
import Data.Default (Default (..))
import Data.Function as F
import Data.Functor (void, (<&>))
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict.InsOrd qualified as IHM
import Data.List.Extra (snoc)
import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe)
import Data.OpenApi (HasExample (..), HasProperties (..), HasRequired (..), HasTitle (..), HasType (..), OpenApiType (..), ToSchema, declareSchemaRef)
import Data.OpenApi qualified as O
import Data.OpenApi.Internal.Schema (named)
import Data.Proxy (Proxy (..))
import Data.Tuple.All (Curry (..), Sel1 (sel1), Sel3 (sel3), Sel4 (sel4), Sel5 (sel5))
import Data.Void (Void)
import GHC.Generics (Generic (..), Rep)
import Language.Haskell.Meta (parseType)
import Language.Haskell.TH
import Opaleye (table, tableField, tableWithSchema)
import Opaleye.Table (Table)
import Tedious.Orphan ()
import Tedious.Util (lowerFirst, toJSONOptions, trimPrefixName_, upperFirst)
import Text.Megaparsec (MonadParsec (takeWhile1P, takeWhileP, try), Parsec, between, empty, errorBundlePretty, optional, parse, (<|>))
import Text.Megaparsec qualified as M
import Text.Megaparsec.Char qualified as MC
import Text.Megaparsec.Char.Lexer qualified as MCL

type TypName = String

type BasTypName = String

type DevTypName = String

type ExtTypName = String

type FldName = String

type FldBasOptional = Bool

type FldLabel = String -- openapi label


type FldTypS = String

type FldSamp = String -- openapi example


type FldTypVar = String

type TblSchema = String

type TblName = String

type TblFldOName = String

type TblFldOTypSW = String

type TblFldOTypSR = String

type FldBasIsMaybe = Bool

type FldExtIsMaybe = Bool

type FldExtVar = String

type TblFldIsPrimary = Bool

type TblFldUnique = String

type TblFldDefault = String

type TblUniqueName = String

type TypInfo = (TypName, [DevTypName], RepTediousFields)

type RepTediousFields = [(FldName, Maybe FldLabel, FldTyp, FldExtIsMaybe, Maybe FldExtVar)]

type RepOpaleye = [(TblFldOName, (FldTypS, FldBasIsMaybe), TblFldOTypSW, TblFldOTypSR)]

type RepPersistTyp = (BasTypName, TblPrimary, [TblUnique], [(FldName, FldTypS, FldBasIsMaybe, Maybe TblFldDefault)])

--


data Combo
  = Combo
      BasTypName -- base type name

      (Maybe TblInfo) -- table name

      (Maybe [DevTypName]) -- derivings

  deriving stock (Combo -> Combo -> FldExtIsMaybe
(Combo -> Combo -> FldExtIsMaybe)
-> (Combo -> Combo -> FldExtIsMaybe) -> Eq Combo
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: Combo -> Combo -> FldExtIsMaybe
== :: Combo -> Combo -> FldExtIsMaybe
$c/= :: Combo -> Combo -> FldExtIsMaybe
/= :: Combo -> Combo -> FldExtIsMaybe
Eq, Int -> Combo -> ShowS
[Combo] -> ShowS
Combo -> String
(Int -> Combo -> ShowS)
-> (Combo -> String) -> ([Combo] -> ShowS) -> Show Combo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Combo -> ShowS
showsPrec :: Int -> Combo -> ShowS
$cshow :: Combo -> String
show :: Combo -> String
$cshowList :: [Combo] -> ShowS
showList :: [Combo] -> ShowS
Show, (forall x. Combo -> Rep Combo x)
-> (forall x. Rep Combo x -> Combo) -> Generic Combo
forall x. Rep Combo x -> Combo
forall x. Combo -> Rep Combo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Combo -> Rep Combo x
from :: forall x. Combo -> Rep Combo x
$cto :: forall x. Rep Combo x -> Combo
to :: forall x. Rep Combo x -> Combo
Generic)

data TblInfo = TblInfoQualified TblSchema TblName | TblInfoUnQualified TblName
  deriving stock (TblInfo -> TblInfo -> FldExtIsMaybe
(TblInfo -> TblInfo -> FldExtIsMaybe)
-> (TblInfo -> TblInfo -> FldExtIsMaybe) -> Eq TblInfo
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TblInfo -> TblInfo -> FldExtIsMaybe
== :: TblInfo -> TblInfo -> FldExtIsMaybe
$c/= :: TblInfo -> TblInfo -> FldExtIsMaybe
/= :: TblInfo -> TblInfo -> FldExtIsMaybe
Eq, Int -> TblInfo -> ShowS
[TblInfo] -> ShowS
TblInfo -> String
(Int -> TblInfo -> ShowS)
-> (TblInfo -> String) -> ([TblInfo] -> ShowS) -> Show TblInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblInfo -> ShowS
showsPrec :: Int -> TblInfo -> ShowS
$cshow :: TblInfo -> String
show :: TblInfo -> String
$cshowList :: [TblInfo] -> ShowS
showList :: [TblInfo] -> ShowS
Show, (forall x. TblInfo -> Rep TblInfo x)
-> (forall x. Rep TblInfo x -> TblInfo) -> Generic TblInfo
forall x. Rep TblInfo x -> TblInfo
forall x. TblInfo -> Rep TblInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TblInfo -> Rep TblInfo x
from :: forall x. TblInfo -> Rep TblInfo x
$cto :: forall x. Rep TblInfo x -> TblInfo
to :: forall x. Rep TblInfo x -> TblInfo
Generic)

data ComboAttr = ComboTblInfo TblInfo | ComboDevTyp [DevTypName]
  deriving stock (ComboAttr -> ComboAttr -> FldExtIsMaybe
(ComboAttr -> ComboAttr -> FldExtIsMaybe)
-> (ComboAttr -> ComboAttr -> FldExtIsMaybe) -> Eq ComboAttr
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: ComboAttr -> ComboAttr -> FldExtIsMaybe
== :: ComboAttr -> ComboAttr -> FldExtIsMaybe
$c/= :: ComboAttr -> ComboAttr -> FldExtIsMaybe
/= :: ComboAttr -> ComboAttr -> FldExtIsMaybe
Eq, Int -> ComboAttr -> ShowS
[ComboAttr] -> ShowS
ComboAttr -> String
(Int -> ComboAttr -> ShowS)
-> (ComboAttr -> String)
-> ([ComboAttr] -> ShowS)
-> Show ComboAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComboAttr -> ShowS
showsPrec :: Int -> ComboAttr -> ShowS
$cshow :: ComboAttr -> String
show :: ComboAttr -> String
$cshowList :: [ComboAttr] -> ShowS
showList :: [ComboAttr] -> ShowS
Show, (forall x. ComboAttr -> Rep ComboAttr x)
-> (forall x. Rep ComboAttr x -> ComboAttr) -> Generic ComboAttr
forall x. Rep ComboAttr x -> ComboAttr
forall x. ComboAttr -> Rep ComboAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComboAttr -> Rep ComboAttr x
from :: forall x. ComboAttr -> Rep ComboAttr x
$cto :: forall x. Rep ComboAttr x -> ComboAttr
to :: forall x. Rep ComboAttr x -> ComboAttr
Generic)

data Field
  = Field
      (FldName, FldBasOptional, Maybe FldLabel) -- (field name, appear in base type or not, field label used in openapi schema)

      FldTyp -- field type

      [ExtTyp] -- (name of ext type which has this field, the field of the ext type is maybe or not)

  deriving stock (Field -> Field -> FldExtIsMaybe
(Field -> Field -> FldExtIsMaybe)
-> (Field -> Field -> FldExtIsMaybe) -> Eq Field
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: Field -> Field -> FldExtIsMaybe
== :: Field -> Field -> FldExtIsMaybe
$c/= :: Field -> Field -> FldExtIsMaybe
/= :: Field -> Field -> FldExtIsMaybe
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Field -> Rep Field x
from :: forall x. Field -> Rep Field x
$cto :: forall x. Rep Field x -> Field
to :: forall x. Rep Field x -> Field
Generic)

data FldTyp
  = FldTypNormal FldTypS FldBasIsMaybe (Maybe FldSamp) (Maybe TblFld) -- type of field on base type, field is maybe or not, example value in openapi schema, table field info

  | FldTypPoly FldTypVar FldBasIsMaybe
  deriving stock (FldTyp -> FldTyp -> FldExtIsMaybe
(FldTyp -> FldTyp -> FldExtIsMaybe)
-> (FldTyp -> FldTyp -> FldExtIsMaybe) -> Eq FldTyp
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: FldTyp -> FldTyp -> FldExtIsMaybe
== :: FldTyp -> FldTyp -> FldExtIsMaybe
$c/= :: FldTyp -> FldTyp -> FldExtIsMaybe
/= :: FldTyp -> FldTyp -> FldExtIsMaybe
Eq, Int -> FldTyp -> ShowS
[FldTyp] -> ShowS
FldTyp -> String
(Int -> FldTyp -> ShowS)
-> (FldTyp -> String) -> ([FldTyp] -> ShowS) -> Show FldTyp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FldTyp -> ShowS
showsPrec :: Int -> FldTyp -> ShowS
$cshow :: FldTyp -> String
show :: FldTyp -> String
$cshowList :: [FldTyp] -> ShowS
showList :: [FldTyp] -> ShowS
Show, (forall x. FldTyp -> Rep FldTyp x)
-> (forall x. Rep FldTyp x -> FldTyp) -> Generic FldTyp
forall x. Rep FldTyp x -> FldTyp
forall x. FldTyp -> Rep FldTyp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FldTyp -> Rep FldTyp x
from :: forall x. FldTyp -> Rep FldTyp x
$cto :: forall x. Rep FldTyp x -> FldTyp
to :: forall x. Rep FldTyp x -> FldTyp
Generic)

data TblFld = TblFld TblFldOpaleye TblFldIsPrimary [TblFldUnique] (Maybe TblFldDefault)
  deriving stock (TblFld -> TblFld -> FldExtIsMaybe
(TblFld -> TblFld -> FldExtIsMaybe)
-> (TblFld -> TblFld -> FldExtIsMaybe) -> Eq TblFld
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TblFld -> TblFld -> FldExtIsMaybe
== :: TblFld -> TblFld -> FldExtIsMaybe
$c/= :: TblFld -> TblFld -> FldExtIsMaybe
/= :: TblFld -> TblFld -> FldExtIsMaybe
Eq, Int -> TblFld -> ShowS
[TblFld] -> ShowS
TblFld -> String
(Int -> TblFld -> ShowS)
-> (TblFld -> String) -> ([TblFld] -> ShowS) -> Show TblFld
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblFld -> ShowS
showsPrec :: Int -> TblFld -> ShowS
$cshow :: TblFld -> String
show :: TblFld -> String
$cshowList :: [TblFld] -> ShowS
showList :: [TblFld] -> ShowS
Show, (forall x. TblFld -> Rep TblFld x)
-> (forall x. Rep TblFld x -> TblFld) -> Generic TblFld
forall x. Rep TblFld x -> TblFld
forall x. TblFld -> Rep TblFld x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TblFld -> Rep TblFld x
from :: forall x. TblFld -> Rep TblFld x
$cto :: forall x. Rep TblFld x -> TblFld
to :: forall x. Rep TblFld x -> TblFld
Generic)

data ExtTyp = ExtTypNormal ExtTypName FldExtIsMaybe | ExtTypPoly ExtTypName FldExtVar FldExtIsMaybe
  deriving stock (ExtTyp -> ExtTyp -> FldExtIsMaybe
(ExtTyp -> ExtTyp -> FldExtIsMaybe)
-> (ExtTyp -> ExtTyp -> FldExtIsMaybe) -> Eq ExtTyp
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: ExtTyp -> ExtTyp -> FldExtIsMaybe
== :: ExtTyp -> ExtTyp -> FldExtIsMaybe
$c/= :: ExtTyp -> ExtTyp -> FldExtIsMaybe
/= :: ExtTyp -> ExtTyp -> FldExtIsMaybe
Eq, Int -> ExtTyp -> ShowS
[ExtTyp] -> ShowS
ExtTyp -> String
(Int -> ExtTyp -> ShowS)
-> (ExtTyp -> String) -> ([ExtTyp] -> ShowS) -> Show ExtTyp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtTyp -> ShowS
showsPrec :: Int -> ExtTyp -> ShowS
$cshow :: ExtTyp -> String
show :: ExtTyp -> String
$cshowList :: [ExtTyp] -> ShowS
showList :: [ExtTyp] -> ShowS
Show, (forall x. ExtTyp -> Rep ExtTyp x)
-> (forall x. Rep ExtTyp x -> ExtTyp) -> Generic ExtTyp
forall x. Rep ExtTyp x -> ExtTyp
forall x. ExtTyp -> Rep ExtTyp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtTyp -> Rep ExtTyp x
from :: forall x. ExtTyp -> Rep ExtTyp x
$cto :: forall x. Rep ExtTyp x -> ExtTyp
to :: forall x. Rep ExtTyp x -> ExtTyp
Generic)

data TblFldOpaleye
  = TblFldOR TblFldOTypSR -- omit field name, write type and read type are same. eg. (Field Text)

  | TblFldOWR TblFldOTypSW TblFldOTypSR -- omit field name, write type and read type are diff. eg. (Maybe (Field Text), Field Text)

  | TblFldONR TblFldOName TblFldOTypSR -- write type and read type are same. eg. ("field_name", Field Text)

  | TblFldONWR TblFldOName TblFldOTypSW TblFldOTypSR -- write type and read type are diff. eg. ("field_name", Maybe (Field Text), Field Text)

  deriving stock (TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe
(TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe)
-> (TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe)
-> Eq TblFldOpaleye
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe
== :: TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe
$c/= :: TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe
/= :: TblFldOpaleye -> TblFldOpaleye -> FldExtIsMaybe
Eq, Int -> TblFldOpaleye -> ShowS
[TblFldOpaleye] -> ShowS
TblFldOpaleye -> String
(Int -> TblFldOpaleye -> ShowS)
-> (TblFldOpaleye -> String)
-> ([TblFldOpaleye] -> ShowS)
-> Show TblFldOpaleye
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblFldOpaleye -> ShowS
showsPrec :: Int -> TblFldOpaleye -> ShowS
$cshow :: TblFldOpaleye -> String
show :: TblFldOpaleye -> String
$cshowList :: [TblFldOpaleye] -> ShowS
showList :: [TblFldOpaleye] -> ShowS
Show, (forall x. TblFldOpaleye -> Rep TblFldOpaleye x)
-> (forall x. Rep TblFldOpaleye x -> TblFldOpaleye)
-> Generic TblFldOpaleye
forall x. Rep TblFldOpaleye x -> TblFldOpaleye
forall x. TblFldOpaleye -> Rep TblFldOpaleye x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TblFldOpaleye -> Rep TblFldOpaleye x
from :: forall x. TblFldOpaleye -> Rep TblFldOpaleye x
$cto :: forall x. Rep TblFldOpaleye x -> TblFldOpaleye
to :: forall x. Rep TblFldOpaleye x -> TblFldOpaleye
Generic)

newtype TblPrimary = TblPrimary [FldName]
  deriving stock (TblPrimary -> TblPrimary -> FldExtIsMaybe
(TblPrimary -> TblPrimary -> FldExtIsMaybe)
-> (TblPrimary -> TblPrimary -> FldExtIsMaybe) -> Eq TblPrimary
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TblPrimary -> TblPrimary -> FldExtIsMaybe
== :: TblPrimary -> TblPrimary -> FldExtIsMaybe
$c/= :: TblPrimary -> TblPrimary -> FldExtIsMaybe
/= :: TblPrimary -> TblPrimary -> FldExtIsMaybe
Eq, Int -> TblPrimary -> ShowS
[TblPrimary] -> ShowS
TblPrimary -> String
(Int -> TblPrimary -> ShowS)
-> (TblPrimary -> String)
-> ([TblPrimary] -> ShowS)
-> Show TblPrimary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblPrimary -> ShowS
showsPrec :: Int -> TblPrimary -> ShowS
$cshow :: TblPrimary -> String
show :: TblPrimary -> String
$cshowList :: [TblPrimary] -> ShowS
showList :: [TblPrimary] -> ShowS
Show, (forall x. TblPrimary -> Rep TblPrimary x)
-> (forall x. Rep TblPrimary x -> TblPrimary) -> Generic TblPrimary
forall x. Rep TblPrimary x -> TblPrimary
forall x. TblPrimary -> Rep TblPrimary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TblPrimary -> Rep TblPrimary x
from :: forall x. TblPrimary -> Rep TblPrimary x
$cto :: forall x. Rep TblPrimary x -> TblPrimary
to :: forall x. Rep TblPrimary x -> TblPrimary
Generic)

data TblUnique = TblUnique TblUniqueName [FldName]
  deriving stock (TblUnique -> TblUnique -> FldExtIsMaybe
(TblUnique -> TblUnique -> FldExtIsMaybe)
-> (TblUnique -> TblUnique -> FldExtIsMaybe) -> Eq TblUnique
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TblUnique -> TblUnique -> FldExtIsMaybe
== :: TblUnique -> TblUnique -> FldExtIsMaybe
$c/= :: TblUnique -> TblUnique -> FldExtIsMaybe
/= :: TblUnique -> TblUnique -> FldExtIsMaybe
Eq, Int -> TblUnique -> ShowS
[TblUnique] -> ShowS
TblUnique -> String
(Int -> TblUnique -> ShowS)
-> (TblUnique -> String)
-> ([TblUnique] -> ShowS)
-> Show TblUnique
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblUnique -> ShowS
showsPrec :: Int -> TblUnique -> ShowS
$cshow :: TblUnique -> String
show :: TblUnique -> String
$cshowList :: [TblUnique] -> ShowS
showList :: [TblUnique] -> ShowS
Show, (forall x. TblUnique -> Rep TblUnique x)
-> (forall x. Rep TblUnique x -> TblUnique) -> Generic TblUnique
forall x. Rep TblUnique x -> TblUnique
forall x. TblUnique -> Rep TblUnique x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TblUnique -> Rep TblUnique x
from :: forall x. TblUnique -> Rep TblUnique x
$cto :: forall x. Rep TblUnique x -> TblUnique
to :: forall x. Rep TblUnique x -> TblUnique
Generic)

data TediousTyp = TediousTyp Combo [Field]
  deriving stock (TediousTyp -> TediousTyp -> FldExtIsMaybe
(TediousTyp -> TediousTyp -> FldExtIsMaybe)
-> (TediousTyp -> TediousTyp -> FldExtIsMaybe) -> Eq TediousTyp
forall a.
(a -> a -> FldExtIsMaybe) -> (a -> a -> FldExtIsMaybe) -> Eq a
$c== :: TediousTyp -> TediousTyp -> FldExtIsMaybe
== :: TediousTyp -> TediousTyp -> FldExtIsMaybe
$c/= :: TediousTyp -> TediousTyp -> FldExtIsMaybe
/= :: TediousTyp -> TediousTyp -> FldExtIsMaybe
Eq, Int -> TediousTyp -> ShowS
[TediousTyp] -> ShowS
TediousTyp -> String
(Int -> TediousTyp -> ShowS)
-> (TediousTyp -> String)
-> ([TediousTyp] -> ShowS)
-> Show TediousTyp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TediousTyp -> ShowS
showsPrec :: Int -> TediousTyp -> ShowS
$cshow :: TediousTyp -> String
show :: TediousTyp -> String
$cshowList :: [TediousTyp] -> ShowS
showList :: [TediousTyp] -> ShowS
Show, (forall x. TediousTyp -> Rep TediousTyp x)
-> (forall x. Rep TediousTyp x -> TediousTyp) -> Generic TediousTyp
forall x. Rep TediousTyp x -> TediousTyp
forall x. TediousTyp -> Rep TediousTyp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TediousTyp -> Rep TediousTyp x
from :: forall x. TediousTyp -> Rep TediousTyp x
$cto :: forall x. Rep TediousTyp x -> TediousTyp
to :: forall x. Rep TediousTyp x -> TediousTyp
Generic)

--


type Parser = Parsec Void String

lineComment :: Parser ()
lineComment :: Parser ()
lineComment = Tokens String -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
MCL.skipLineComment Tokens String
"--"

sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
MCL.space (ParsecT Void String Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String -> Parser ())
-> ParsecT Void String Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
' ' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\t')) Parser ()
lineComment Parser ()
forall a. ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

scn :: Parser ()
scn :: Parser ()
scn = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
MCL.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MC.space1 Parser ()
lineComment Parser ()
forall a. ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
MCL.lexeme Parser ()
sc

isNameChar :: Char -> Bool
isNameChar :: Char -> FldExtIsMaybe
isNameChar Char
c = Char -> FldExtIsMaybe
isAlphaNum Char
c FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
|| Char
c Char -> Char -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== Char
'_' FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
|| Char
c Char -> Char -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== Char
'\''

pName :: Parser String
pName :: ParsecT Void String Identity String
pName = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pName_

pName_ :: Parser String
pName_ :: ParsecT Void String Identity String
pName_ = Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> FldExtIsMaybe
Token String -> FldExtIsMaybe
isNameChar

pNameLower :: Parser String
pNameLower :: ParsecT Void String Identity String
pNameLower = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pNameLower_

pNameLower_ :: Parser String
pNameLower_ :: ParsecT Void String Identity String
pNameLower_ = String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> FldExtIsMaybe
Token String -> FldExtIsMaybe
isLowerCase ParsecT Void String Identity ShowS
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> FldExtIsMaybe
Token String -> FldExtIsMaybe
isNameChar

pNameUpper :: Parser String
pNameUpper :: ParsecT Void String Identity String
pNameUpper = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pNameUpper_

pNameUpper_ :: Parser String
pNameUpper_ :: ParsecT Void String Identity String
pNameUpper_ = String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> FldExtIsMaybe
Token String -> FldExtIsMaybe
isUpperCase ParsecT Void String Identity ShowS
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> FldExtIsMaybe
Token String -> FldExtIsMaybe
isNameChar

string :: String -> Parser String
string :: String -> ParsecT Void String Identity String
string = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT Void String Identity String
Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string

symbol :: String -> Parser String
symbol :: String -> ParsecT Void String Identity String
symbol = Parser ()
-> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
MCL.symbol Parser ()
sc

parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"(") (String -> ParsecT Void String Identity String
symbol String
")")

parens_ :: Parser a -> Parser a
parens_ :: forall a. Parser a -> Parser a
parens_ = ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"(") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
')')

parens' :: Parser String -> Parser String
parens' :: ParsecT Void String Identity String
-> ParsecT Void String Identity String
parens' ParsecT Void String Identity String
p = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"(", ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"(") (String -> ParsecT Void String Identity String
symbol String
")") ParsecT Void String Identity String
p, String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
")"]

parens'_ :: Parser String -> Parser String
parens'_ :: ParsecT Void String Identity String
-> ParsecT Void String Identity String
parens'_ ParsecT Void String Identity String
p = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"(", ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"(") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
')') ParsecT Void String Identity String
p, String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
")"]

brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"[") (String -> ParsecT Void String Identity String
symbol String
"]")

brackets_ :: Parser a -> Parser a
brackets_ :: forall a. Parser a -> Parser a
brackets_ = ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"[") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
']')

brackets' :: Parser String -> Parser String
brackets' :: ParsecT Void String Identity String
-> ParsecT Void String Identity String
brackets' ParsecT Void String Identity String
p = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"[", ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"[") (String -> ParsecT Void String Identity String
symbol String
"]") ParsecT Void String Identity String
p, String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"]"]

brackets'_ :: Parser String -> Parser String
brackets'_ :: ParsecT Void String Identity String
-> ParsecT Void String Identity String
brackets'_ ParsecT Void String Identity String
p = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void String Identity String]
-> ParsecT Void String Identity [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"[", ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"[") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
']') ParsecT Void String Identity String
p, String -> ParsecT Void String Identity String
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"]"]

quotes :: Parser a -> Parser a
quotes :: forall a. Parser a -> Parser a
quotes = ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"\"") (String -> ParsecT Void String Identity String
symbol String
"\"")

quotes_ :: Parser a -> Parser a
quotes_ :: forall a. Parser a -> Parser a
quotes_ = ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"\"") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\"')

backQuotes :: Parser a -> Parser a
backQuotes :: forall a. Parser a -> Parser a
backQuotes = ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"`") (String -> ParsecT Void String Identity String
symbol String
"`")

backQuotes_ :: Parser a -> Parser a
backQuotes_ :: forall a. Parser a -> Parser a
backQuotes_ = ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"`") (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'`')

backQuoteString :: Parser String
backQuoteString :: ParsecT Void String Identity String
backQuoteString = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> (ParsecT Void String Identity String
    -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
backQuotes (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token String -> FldExtIsMaybe)
-> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> FldExtIsMaybe) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token String
c -> Char -> FldExtIsMaybe
isPrint Char
Token String
c FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
&& Char
Token String
c Char -> Char -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
/= Char
'`')

pTblInfo :: Parser TblInfo
pTblInfo :: Parser TblInfo
pTblInfo = String -> ParsecT Void String Identity String
string String
"table" ParsecT Void String Identity String
-> Parser TblInfo -> Parser TblInfo
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TblInfo -> Parser TblInfo
forall a. Parser a -> Parser a
parens (String -> String -> TblInfo
TblInfoQualified (String -> String -> TblInfo)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> TblInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pName ParsecT Void String Identity (String -> TblInfo)
-> ParsecT Void String Identity String -> Parser TblInfo
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
pName)) Parser TblInfo -> Parser TblInfo -> Parser TblInfo
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> TblInfo
TblInfoUnQualified (String -> TblInfo)
-> ParsecT Void String Identity String -> Parser TblInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pName))

pDevTyp :: Parser [DevTypName]
pDevTyp :: ParsecT Void String Identity [String]
pDevTyp = String -> ParsecT Void String Identity String
string String
"deriving" ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ParsecT Void String Identity String
pNameUpper)

pComboAttr :: Parser ComboAttr
pComboAttr :: Parser ComboAttr
pComboAttr = (TblInfo -> ComboAttr
ComboTblInfo (TblInfo -> ComboAttr) -> Parser TblInfo -> Parser ComboAttr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TblInfo
pTblInfo) Parser ComboAttr -> Parser ComboAttr -> Parser ComboAttr
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([String] -> ComboAttr
ComboDevTyp ([String] -> ComboAttr)
-> ParsecT Void String Identity [String] -> Parser ComboAttr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity [String]
pDevTyp)

pComboAttrs :: Parser (Maybe TblInfo, Maybe [DevTypName])
pComboAttrs :: Parser (Maybe TblInfo, Maybe [String])
pComboAttrs = do
  [ComboAttr]
attrs <- Parser ComboAttr -> ParsecT Void String Identity [ComboAttr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser ComboAttr
pComboAttr
  let attrTblName :: Maybe TblInfo
attrTblName = [TblInfo] -> Maybe TblInfo
forall a. [a] -> Maybe a
listToMaybe ([TblInfo] -> Maybe TblInfo) -> [TblInfo] -> Maybe TblInfo
forall a b. (a -> b) -> a -> b
$ (ComboAttr -> Maybe TblInfo) -> [ComboAttr] -> [TblInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case (ComboTblInfo TblInfo
tblInfo) -> TblInfo -> Maybe TblInfo
forall a. a -> Maybe a
Just TblInfo
tblInfo; ComboAttr
_ -> Maybe TblInfo
forall a. Maybe a
Nothing) [ComboAttr]
attrs
  let attrDevTyp :: Maybe [String]
attrDevTyp = [[String]] -> Maybe [String]
forall a. [a] -> Maybe a
listToMaybe ([[String]] -> Maybe [String]) -> [[String]] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ (ComboAttr -> Maybe [String]) -> [ComboAttr] -> [[String]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case (ComboDevTyp [String]
devTyps) -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
devTyps; ComboAttr
_ -> Maybe [String]
forall a. Maybe a
Nothing) [ComboAttr]
attrs
  (Maybe TblInfo, Maybe [String])
-> Parser (Maybe TblInfo, Maybe [String])
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TblInfo
attrTblName, Maybe [String]
attrDevTyp)

pCombo :: Parser Combo
pCombo :: Parser Combo
pCombo = (Maybe TblInfo -> Maybe [String] -> Combo)
-> (Maybe TblInfo, Maybe [String]) -> Combo
forall a b. Curry a b => b -> a
uncurryN ((Maybe TblInfo -> Maybe [String] -> Combo)
 -> (Maybe TblInfo, Maybe [String]) -> Combo)
-> (String -> Maybe TblInfo -> Maybe [String] -> Combo)
-> String
-> (Maybe TblInfo, Maybe [String])
-> Combo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe TblInfo -> Maybe [String] -> Combo
Combo (String -> (Maybe TblInfo, Maybe [String]) -> Combo)
-> ParsecT Void String Identity String
-> ParsecT
     Void String Identity ((Maybe TblInfo, Maybe [String]) -> Combo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pNameUpper ParsecT
  Void String Identity ((Maybe TblInfo, Maybe [String]) -> Combo)
-> Parser (Maybe TblInfo, Maybe [String]) -> Parser Combo
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe TblInfo, Maybe [String])
pComboAttrs

pFldName :: Parser FldName
pFldName :: ParsecT Void String Identity String
pFldName = ParsecT Void String Identity String
pNameLower

pFldTitle :: Parser FldLabel
pFldTitle :: ParsecT Void String Identity String
pFldTitle = ParsecT Void String Identity String
backQuoteString

pOccur :: String -> Parser Bool
pOccur :: String -> Parser FldExtIsMaybe
pOccur String
s = (FldExtIsMaybe
True FldExtIsMaybe
-> ParsecT Void String Identity String -> Parser FldExtIsMaybe
forall a b.
a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Void String Identity String
symbol String
s) Parser FldExtIsMaybe
-> Parser FldExtIsMaybe -> Parser FldExtIsMaybe
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FldExtIsMaybe -> Parser FldExtIsMaybe
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FldExtIsMaybe
False

pOccur_ :: String -> Parser Bool
pOccur_ :: String -> Parser FldExtIsMaybe
pOccur_ String
s = Parser FldExtIsMaybe -> Parser FldExtIsMaybe
forall a. Parser a -> Parser a
lexeme (Parser FldExtIsMaybe -> Parser FldExtIsMaybe)
-> Parser FldExtIsMaybe -> Parser FldExtIsMaybe
forall a b. (a -> b) -> a -> b
$ (FldExtIsMaybe
True FldExtIsMaybe
-> ParsecT Void String Identity String -> Parser FldExtIsMaybe
forall a b.
a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Void String Identity String
symbol String
s) Parser FldExtIsMaybe
-> Parser FldExtIsMaybe -> Parser FldExtIsMaybe
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FldExtIsMaybe -> Parser FldExtIsMaybe
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FldExtIsMaybe
False

pFldNameAndTitle :: Parser (FldName, FldBasOptional, Maybe FldLabel)
pFldNameAndTitle :: Parser (String, FldExtIsMaybe, Maybe String)
pFldNameAndTitle = do
  FldExtIsMaybe
_fldBasOptional <- String -> Parser FldExtIsMaybe
pOccur String
"*"
  String
_fldName <- ParsecT Void String Identity String
pFldName
  Maybe String
_mFldLabel <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity String
pFldTitle
  (String, FldExtIsMaybe, Maybe String)
-> Parser (String, FldExtIsMaybe, Maybe String)
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
_fldName, FldExtIsMaybe
_fldBasOptional, Maybe String
_mFldLabel)

pFldTypS :: Parser FldTypS
pFldTypS :: ParsecT Void String Identity String
pFldTypS = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
parens ParsecT Void String Identity String
protoTypS) ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
protoTypS
  where
    protoTypS :: ParsecT Void String Identity String
protoTypS = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity String
arrayTypS ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void String Identity String
tupleTypS ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
comboTypS
    arrayTypS :: ParsecT Void String Identity String
arrayTypS = ParsecT Void String Identity String
-> ParsecT Void String Identity String
brackets' (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pFldTypS)
    tupleTypS :: ParsecT Void String Identity String
tupleTypS = ParsecT Void String Identity String
-> ParsecT Void String Identity String
parens' (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (String -> [String] -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pFldTypS ParsecT Void String Identity ([String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT Void String Identity String
tuplePart)
    comboTypS :: ParsecT Void String Identity String
comboTypS = [String] -> String
unwords ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>) ([String] -> [String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ParsecT Void String Identity String
pNameUpper ParsecT Void String Identity ([String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT Void String Identity String
pFldTypS)
    tuplePart :: ParsecT Void String Identity String
tuplePart = [String] -> String
unwords ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (String -> [String] -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity ([String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
pFldTypS))

pFldSamp :: Parser FldSamp
pFldSamp :: ParsecT Void String Identity String
pFldSamp = ParsecT Void String Identity String
backQuoteString

pFldTyp :: Parser FldTyp
pFldTyp :: Parser FldTyp
pFldTyp = Parser FldTyp -> Parser FldTyp
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> FldExtIsMaybe -> Maybe String -> Maybe TblFld -> FldTyp
FldTypNormal (String -> FldExtIsMaybe -> Maybe String -> Maybe TblFld -> FldTyp)
-> ParsecT Void String Identity String
-> ParsecT
     Void
     String
     Identity
     (FldExtIsMaybe -> Maybe String -> Maybe TblFld -> FldTyp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity String
pNameUpper_ ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
parens_ ParsecT Void String Identity String
pFldTypS ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
-> ParsecT Void String Identity String
brackets'_ ParsecT Void String Identity String
pFldTypS) ParsecT
  Void
  String
  Identity
  (FldExtIsMaybe -> Maybe String -> Maybe TblFld -> FldTyp)
-> Parser FldExtIsMaybe
-> ParsecT
     Void String Identity (Maybe String -> Maybe TblFld -> FldTyp)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser FldExtIsMaybe
pOccur_ String
"?" ParsecT
  Void String Identity (Maybe String -> Maybe TblFld -> FldTyp)
-> ParsecT Void String Identity (Maybe String)
-> ParsecT Void String Identity (Maybe TblFld -> FldTyp)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity String
pFldSamp ParsecT Void String Identity (Maybe TblFld -> FldTyp)
-> ParsecT Void String Identity (Maybe TblFld) -> Parser FldTyp
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity TblFld
-> ParsecT Void String Identity (Maybe TblFld)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity TblFld
pTblFld) Parser FldTyp -> Parser FldTyp -> Parser FldTyp
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> FldExtIsMaybe -> FldTyp
FldTypPoly (String -> FldExtIsMaybe -> FldTyp)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (FldExtIsMaybe -> FldTyp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pNameLower_ ParsecT Void String Identity (FldExtIsMaybe -> FldTyp)
-> Parser FldExtIsMaybe -> Parser FldTyp
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser FldExtIsMaybe
pOccur_ String
"?")

pTblFldUnique :: Parser TblFldUnique
pTblFldUnique :: ParsecT Void String Identity String
pTblFldUnique = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'!' ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
pNameUpper

pTblFldDefault :: Parser String
pTblFldDefault :: ParsecT Void String Identity String
pTblFldDefault = ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Tokens String -> Tokens String -> Tokens String
forall a. Semigroup a => a -> a -> a
(<>) (Tokens String -> Tokens String -> Tokens String)
-> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (Tokens String -> Tokens String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string Tokens String
"default=" ParsecT Void String Identity (Tokens String -> Tokens String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
backQuoteString

pTblFld :: Parser TblFld
pTblFld :: ParsecT Void String Identity TblFld
pTblFld =
  ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFld
pFldP (ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFldOpaleye
forall a. Parser a -> Parser a
parens_ (String -> TblFldOpaleye
TblFldOR (String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity TblFldOpaleye
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pFldO))
    ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFld
pFldP (ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFldOpaleye
forall a. Parser a -> Parser a
parens_ (String -> String -> TblFldOpaleye
TblFldOWR (String -> String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> TblFldOpaleye)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity String
pFldM ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
pFldO) ParsecT Void String Identity (String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity TblFldOpaleye
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
pFldO)))
    ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFld
pFldP (ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFldOpaleye
forall a. Parser a -> Parser a
parens_ (String -> String -> TblFldOpaleye
TblFldONR (String -> String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> TblFldOpaleye)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
quotes ParsecT Void String Identity String
pName ParsecT Void String Identity (String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity TblFldOpaleye
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void String Identity String
pFldM ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
pFldO))))
    ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFld
pFldP (ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFldOpaleye
forall a. Parser a -> Parser a
parens_ (String -> String -> String -> TblFldOpaleye
TblFldONWR (String -> String -> String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> String -> TblFldOpaleye)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
quotes ParsecT Void String Identity String
pName ParsecT Void String Identity (String -> String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> TblFldOpaleye)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void String Identity String
pFldM ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
pFldO)) ParsecT Void String Identity (String -> TblFldOpaleye)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity TblFldOpaleye
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ParsecT Void String Identity String
symbol String
"," ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
pFldO)))
  where
    pFldO :: ParsecT Void String Identity String
pFldO = [String] -> String
unwords ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>) ([String] -> [String] -> [String])
-> (String -> [String]) -> String -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Void String Identity String
symbol String
"FieldNullable" ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Void String Identity String
symbol String
"Field")) ParsecT Void String Identity ([String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pNameUpper))
    pFldM :: ParsecT Void String Identity String
pFldM = [String] -> String
unwords ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
(<>) ([String] -> [String] -> [String])
-> (String -> [String]) -> String -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Void String Identity String
symbol String
"Maybe" ParsecT Void String Identity ([String] -> [String])
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
parens' ParsecT Void String Identity String
pFldO))
    pFldP :: ParsecT Void String Identity TblFldOpaleye
-> ParsecT Void String Identity TblFld
pFldP ParsecT Void String Identity TblFldOpaleye
p = ParsecT Void String Identity TblFld
-> ParsecT Void String Identity TblFld
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TblFldOpaleye
-> FldExtIsMaybe -> [String] -> Maybe String -> TblFld
TblFld (TblFldOpaleye
 -> FldExtIsMaybe -> [String] -> Maybe String -> TblFld)
-> ParsecT Void String Identity TblFldOpaleye
-> ParsecT
     Void
     String
     Identity
     (FldExtIsMaybe -> [String] -> Maybe String -> TblFld)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity TblFldOpaleye
p ParsecT
  Void
  String
  Identity
  (FldExtIsMaybe -> [String] -> Maybe String -> TblFld)
-> Parser FldExtIsMaybe
-> ParsecT
     Void String Identity ([String] -> Maybe String -> TblFld)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser FldExtIsMaybe
pOccur_ String
"#" ParsecT Void String Identity ([String] -> Maybe String -> TblFld)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity (Maybe String -> TblFld)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT Void String Identity String
pTblFldUnique ParsecT Void String Identity (Maybe String -> TblFld)
-> ParsecT Void String Identity (Maybe String)
-> ParsecT Void String Identity TblFld
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity String
pTblFldDefault)

pExtName :: Parser ExtTyp
pExtName :: Parser ExtTyp
pExtName = Parser ExtTyp -> Parser ExtTyp
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (String -> String -> FldExtIsMaybe -> ExtTyp
ExtTypPoly (String -> String -> FldExtIsMaybe -> ExtTyp)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> FldExtIsMaybe -> ExtTyp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pNameUpper_ ParsecT Void String Identity (String -> FldExtIsMaybe -> ExtTyp)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (FldExtIsMaybe -> ExtTyp)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
':' ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
pNameLower_) ParsecT Void String Identity (FldExtIsMaybe -> ExtTyp)
-> Parser FldExtIsMaybe -> Parser ExtTyp
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser FldExtIsMaybe
pOccur_ String
"?") Parser ExtTyp -> Parser ExtTyp -> Parser ExtTyp
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> FldExtIsMaybe -> ExtTyp
ExtTypNormal (String -> FldExtIsMaybe -> ExtTyp)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (FldExtIsMaybe -> ExtTyp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
pNameUpper_ ParsecT Void String Identity (FldExtIsMaybe -> ExtTyp)
-> Parser FldExtIsMaybe -> Parser ExtTyp
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser FldExtIsMaybe
pOccur_ String
"?")

pField :: Parser Field
pField :: Parser Field
pField = (String, FldExtIsMaybe, Maybe String)
-> FldTyp -> [ExtTyp] -> Field
Field ((String, FldExtIsMaybe, Maybe String)
 -> FldTyp -> [ExtTyp] -> Field)
-> Parser (String, FldExtIsMaybe, Maybe String)
-> ParsecT Void String Identity (FldTyp -> [ExtTyp] -> Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (String, FldExtIsMaybe, Maybe String)
pFldNameAndTitle ParsecT Void String Identity (FldTyp -> [ExtTyp] -> Field)
-> Parser FldTyp
-> ParsecT Void String Identity ([ExtTyp] -> Field)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FldTyp
pFldTyp ParsecT Void String Identity ([ExtTyp] -> Field)
-> ParsecT Void String Identity [ExtTyp] -> Parser Field
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExtTyp -> ParsecT Void String Identity [ExtTyp]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser ExtTyp
pExtName

pTediousTyp :: Parser TediousTyp
pTediousTyp :: Parser TediousTyp
pTediousTyp = Parser ()
-> ParsecT
     Void
     String
     Identity
     (IndentOpt (ParsecT Void String Identity) TediousTyp Field)
-> Parser TediousTyp
forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
MCL.indentBlock Parser ()
scn (ParsecT
   Void
   String
   Identity
   (IndentOpt (ParsecT Void String Identity) TediousTyp Field)
 -> Parser TediousTyp)
-> ParsecT
     Void
     String
     Identity
     (IndentOpt (ParsecT Void String Identity) TediousTyp Field)
-> Parser TediousTyp
forall a b. (a -> b) -> a -> b
$ do
  Combo
combo <- Parser Combo
pCombo
  IndentOpt (ParsecT Void String Identity) TediousTyp Field
-> ParsecT
     Void
     String
     Identity
     (IndentOpt (ParsecT Void String Identity) TediousTyp Field)
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IndentOpt (ParsecT Void String Identity) TediousTyp Field
 -> ParsecT
      Void
      String
      Identity
      (IndentOpt (ParsecT Void String Identity) TediousTyp Field))
-> IndentOpt (ParsecT Void String Identity) TediousTyp Field
-> ParsecT
     Void
     String
     Identity
     (IndentOpt (ParsecT Void String Identity) TediousTyp Field)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([Field] -> Parser TediousTyp)
-> Parser Field
-> IndentOpt (ParsecT Void String Identity) TediousTyp Field
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
MCL.IndentSome Maybe Pos
forall a. Maybe a
Nothing (TediousTyp -> Parser TediousTyp
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TediousTyp -> Parser TediousTyp)
-> ([Field] -> TediousTyp) -> [Field] -> Parser TediousTyp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Combo -> [Field] -> TediousTyp
TediousTyp Combo
combo) Parser Field
pField

pTediousTyps :: Parser [TediousTyp]
pTediousTyps :: Parser [TediousTyp]
pTediousTyps = Parser TediousTyp -> Parser [TediousTyp]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser TediousTyp
pTediousTyp

--


defIns :: [String]
defIns :: [String]
defIns = [String
"Eq", String
"Show", String
"Generic", String
"Default", String
"ToJSON", String
"FromJSON", String
"ToSchema"]

repTediousTyp :: TediousTyp -> (HM.HashMap TypName RepTediousFields, [DevTypName])
repTediousTyp :: TediousTyp -> (HashMap String RepTediousFields, [String])
repTediousTyp (TediousTyp (Combo String
basTypName Maybe TblInfo
_ Maybe [String]
devs) [Field]
flds) =
  let hm :: HashMap String RepTediousFields
hm = String
-> [((String, FldExtIsMaybe, Maybe String), FldTyp)]
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
forall {k} {a} {b}.
Hashable k =>
k
-> [((a, FldExtIsMaybe, b), FldTyp)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
defBase String
basTypName ([Field]
flds [Field]
-> (Field -> ((String, FldExtIsMaybe, Maybe String), FldTyp))
-> [((String, FldExtIsMaybe, Maybe String), FldTyp)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Field (String, FldExtIsMaybe, Maybe String)
_fldNameLabel FldTyp
_fldTyp [ExtTyp]
_) -> ((String, FldExtIsMaybe, Maybe String)
_fldNameLabel, FldTyp
_fldTyp))) HashMap String RepTediousFields
forall k v. HashMap k v
HM.empty
   in ([Field]
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
defExts [Field]
flds HashMap String RepTediousFields
hm, (String -> FldExtIsMaybe) -> [String] -> [String]
forall a. (a -> FldExtIsMaybe) -> [a] -> [a]
filter (String -> [String] -> FldExtIsMaybe
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> FldExtIsMaybe
`notElem` [String]
defIns) ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty Maybe [String]
devs))
  where
    defBase :: k
-> [((a, FldExtIsMaybe, b), FldTyp)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
defBase k
_basTypName [((a, FldExtIsMaybe, b), FldTyp)]
tuples =
      k
-> [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
-> HashMap k [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert
        k
_basTypName
        ( (((a, FldExtIsMaybe, b), FldTyp)
 -> Maybe (a, b, FldTyp, FldExtIsMaybe, Maybe String))
-> [((a, FldExtIsMaybe, b), FldTyp)]
-> [(a, b, FldTyp, FldExtIsMaybe, Maybe String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            ( \((a
_fldName, FldExtIsMaybe
_fldBasOptional, b
_mFldTitle), FldTyp
_fldTyp) ->
                if FldExtIsMaybe
_fldBasOptional
                  then Maybe (a, b, FldTyp, FldExtIsMaybe, Maybe String)
forall a. Maybe a
Nothing
                  else (a, b, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe (a, b, FldTyp, FldExtIsMaybe, Maybe String)
forall a. a -> Maybe a
Just ((a, b, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe (a, b, FldTyp, FldExtIsMaybe, Maybe String))
-> (a, b, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe (a, b, FldTyp, FldExtIsMaybe, Maybe String)
forall a b. (a -> b) -> a -> b
$ case FldTyp
_fldTyp of
                    FldTypPoly String
_fldExtVar FldExtIsMaybe
_fldExtIsM -> (a
_fldName, b
_mFldTitle, FldTyp
_fldTyp, FldExtIsMaybe
_fldExtIsM, String -> Maybe String
forall a. a -> Maybe a
Just String
_fldExtVar)
                    FldTyp
_ -> (a
_fldName, b
_mFldTitle, FldTyp
_fldTyp, FldExtIsMaybe
False, Maybe String
forall a. Maybe a
Nothing)
            )
            [((a, FldExtIsMaybe, b), FldTyp)]
tuples
        )
    defExts :: [Field]
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
defExts [] HashMap String RepTediousFields
m = HashMap String RepTediousFields
m
    defExts (Field (String, FldExtIsMaybe, Maybe String)
_ FldTyp
_ [] : [Field]
ds) HashMap String RepTediousFields
m = [Field]
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
defExts [Field]
ds HashMap String RepTediousFields
m
    defExts (Field (String
_fldName, FldExtIsMaybe
_fldBasOptional, Maybe String
_mFldTitle) FldTyp
_fldTyp (ExtTyp
extTyp : [ExtTyp]
extTyps) : [Field]
_flds) HashMap String RepTediousFields
m =
      let (String
_extTypName, FldExtIsMaybe
_fldExtIsM, Maybe String
_mFldExtVar) = ExtTyp -> (String, FldExtIsMaybe, Maybe String)
procExtTyp ExtTyp
extTyp
          m' :: HashMap String RepTediousFields
m' = String
-> RepTediousFields
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert String
_extTypName (RepTediousFields
-> (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> RepTediousFields
forall a. [a] -> a -> [a]
snoc (RepTediousFields
-> String -> HashMap String RepTediousFields -> RepTediousFields
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault [] String
_extTypName HashMap String RepTediousFields
m) (String
_fldName, Maybe String
_mFldTitle, FldTyp
_fldTyp, FldExtIsMaybe
_fldExtIsM, Maybe String
_mFldExtVar)) HashMap String RepTediousFields
m
       in [Field]
-> HashMap String RepTediousFields
-> HashMap String RepTediousFields
defExts ((String, FldExtIsMaybe, Maybe String)
-> FldTyp -> [ExtTyp] -> Field
Field (String
_fldName, FldExtIsMaybe
_fldBasOptional, Maybe String
_mFldTitle) FldTyp
_fldTyp [ExtTyp]
extTyps Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
_flds) HashMap String RepTediousFields
m'
    procExtTyp :: ExtTyp -> (String, FldExtIsMaybe, Maybe String)
procExtTyp ExtTyp
extTyp = case ExtTyp
extTyp of
      ExtTypNormal String
_extTypName FldExtIsMaybe
_fldExtIsM -> (String
_extTypName, FldExtIsMaybe
_fldExtIsM, Maybe String
forall a. Maybe a
Nothing)
      ExtTypPoly String
_extTypName String
_fldExtVar FldExtIsMaybe
_fldExtIsM -> (String
_extTypName, FldExtIsMaybe
_fldExtIsM, String -> Maybe String
forall a. a -> Maybe a
Just String
_fldExtVar)

repOpaleye :: [Field] -> RepOpaleye
repOpaleye :: [Field] -> RepOpaleye
repOpaleye = (Field -> Maybe (String, (String, FldExtIsMaybe), String, String))
-> [Field] -> RepOpaleye
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Field -> Maybe (String, (String, FldExtIsMaybe), String, String)
go
  where
    go :: Field -> Maybe (String, (String, FldExtIsMaybe), String, String)
go (Field (String
_fldName, FldExtIsMaybe
_, Maybe String
_) FldTyp
_fldTyp [ExtTyp]
_) = case FldTyp
_fldTyp of
      FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_ Maybe TblFld
_mTblFld -> case Maybe TblFld
_mTblFld of
        Maybe TblFld
Nothing -> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. Maybe a
Nothing
        Just (TblFld TblFldOpaleye
_tblFld FldExtIsMaybe
_ [String]
_ Maybe String
_) -> case TblFldOpaleye
_tblFld of
          TblFldOR String
_tblFldTypSR -> (String, (String, FldExtIsMaybe), String, String)
-> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. a -> Maybe a
Just (String
_fldName, (String
_fldTypS, FldExtIsMaybe
_fldBasIsM), String
_tblFldTypSR, String
_tblFldTypSR)
          TblFldOWR String
_tblFldTypSW String
_tblFldTypSR -> (String, (String, FldExtIsMaybe), String, String)
-> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. a -> Maybe a
Just (String
_fldName, (String
_fldTypS, FldExtIsMaybe
_fldBasIsM), String
_tblFldTypSW, String
_tblFldTypSR)
          TblFldONR String
_tblFldName String
_tblFldTypSR -> (String, (String, FldExtIsMaybe), String, String)
-> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. a -> Maybe a
Just (String
_tblFldName, (String
_fldTypS, FldExtIsMaybe
_fldBasIsM), String
_tblFldTypSR, String
_tblFldTypSR)
          TblFldONWR String
_tblFldName String
_tblFldTypSW String
_tblFldTypSR -> (String, (String, FldExtIsMaybe), String, String)
-> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. a -> Maybe a
Just (String
_tblFldName, (String
_fldTypS, FldExtIsMaybe
_fldBasIsM), String
_tblFldTypSW, String
_tblFldTypSR)
      FldTyp
_ -> Maybe (String, (String, FldExtIsMaybe), String, String)
forall a. Maybe a
Nothing

repPersistTyp :: TediousTyp -> RepPersistTyp
repPersistTyp :: TediousTyp -> RepPersistTyp
repPersistTyp (TediousTyp (Combo String
basTypName Maybe TblInfo
_ Maybe [String]
_) [Field]
flds) =
  let primaryCons :: TblPrimary
primaryCons = [String] -> TblPrimary
TblPrimary ([Field] -> [String]
genPrimaryCons [Field]
flds)
      uniqueCons :: [TblUnique]
uniqueCons = [Field] -> [TblUnique] -> [TblUnique]
genUniqueCons [Field]
flds []
      persistFlds :: [(String, String, FldExtIsMaybe, Maybe String)]
persistFlds = (Field -> Maybe (String, String, FldExtIsMaybe, Maybe String))
-> [Field] -> [(String, String, FldExtIsMaybe, Maybe String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Field -> Maybe (String, String, FldExtIsMaybe, Maybe String)
genPersistFld [Field]
flds
   in (String
basTypName, TblPrimary
primaryCons, [TblUnique]
uniqueCons, [(String, String, FldExtIsMaybe, Maybe String)]
persistFlds)
  where
    genPrimaryCons :: [Field] -> [String]
genPrimaryCons = (Field -> Maybe String) -> [Field] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Field -> Maybe String
extractPrimary
    extractPrimary :: Field -> Maybe String
extractPrimary (Field (String
_fldName, FldExtIsMaybe
_, Maybe String
_) FldTyp
_fldTyp [ExtTyp]
_) = case FldTyp
_fldTyp of
      FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_ Maybe TblFld
_mTblFld -> case Maybe TblFld
_mTblFld of
        Maybe TblFld
Nothing -> Maybe String
forall a. Maybe a
Nothing
        Just (TblFld TblFldOpaleye
_ FldExtIsMaybe
isPrimary [String]
_ Maybe String
_def) -> if FldExtIsMaybe
isPrimary then String -> Maybe String
forall a. a -> Maybe a
Just String
_fldName else Maybe String
forall a. Maybe a
Nothing
      FldTyp
_ -> Maybe String
forall a. Maybe a
Nothing
    genUniqueCons :: [Field] -> [TblUnique] -> [TblUnique]
genUniqueCons [] [TblUnique]
uCons = [TblUnique]
uCons
    genUniqueCons ((Field (String
_fldName, FldExtIsMaybe
_, Maybe String
_) FldTyp
_fldTyp [ExtTyp]
_) : [Field]
_flds) [TblUnique]
uCons = case FldTyp
_fldTyp of
      FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_ Maybe TblFld
_mTblFld -> case Maybe TblFld
_mTblFld of
        Maybe TblFld
Nothing -> [Field] -> [TblUnique] -> [TblUnique]
genUniqueCons [Field]
_flds [TblUnique]
uCons
        Just (TblFld TblFldOpaleye
_ FldExtIsMaybe
_ [String]
uNames Maybe String
_) -> [Field] -> [TblUnique] -> [TblUnique]
genUniqueCons [Field]
_flds (String -> [String] -> [TblUnique] -> [TblUnique]
extractUnique String
_fldName [String]
uNames [TblUnique]
uCons)
      FldTyp
_ -> []
    extractUnique :: String -> [String] -> [TblUnique] -> [TblUnique]
extractUnique String
_fldName [] [TblUnique]
uCons = [TblUnique]
uCons
    extractUnique String
_fldName (String
uName : [String]
uNames) [TblUnique]
uCons = String -> [String] -> [TblUnique] -> [TblUnique]
extractUnique String
_fldName [String]
uNames (String -> String -> [TblUnique] -> [TblUnique] -> [TblUnique]
extractUniqueOne String
_fldName String
uName [TblUnique]
uCons [])
    extractUniqueOne :: String -> String -> [TblUnique] -> [TblUnique] -> [TblUnique]
extractUniqueOne String
_fldName String
uName [] [TblUnique]
uCons = [TblUnique] -> [TblUnique]
forall a. [a] -> [a]
reverse (String -> [String] -> TblUnique
TblUnique String
uName [String
_fldName] TblUnique -> [TblUnique] -> [TblUnique]
forall a. a -> [a] -> [a]
: [TblUnique]
uCons)
    extractUniqueOne String
_fldName String
uName (uCon :: TblUnique
uCon@(TblUnique String
uConName [String]
uConFlds) : [TblUnique]
uCons_) [TblUnique]
uCons =
      if String
uName String -> String -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== String
uConName
        then [TblUnique] -> [TblUnique]
forall a. [a] -> [a]
reverse [TblUnique]
uCons_ [TblUnique] -> [TblUnique] -> [TblUnique]
forall a. Semigroup a => a -> a -> a
<> (String -> [String] -> TblUnique
TblUnique String
uConName ([String] -> String -> [String]
forall a. [a] -> a -> [a]
snoc [String]
uConFlds String
_fldName) TblUnique -> [TblUnique] -> [TblUnique]
forall a. a -> [a] -> [a]
: [TblUnique]
uCons)
        else String -> String -> [TblUnique] -> [TblUnique] -> [TblUnique]
extractUniqueOne String
_fldName String
uName [TblUnique]
uCons_ (TblUnique
uCon TblUnique -> [TblUnique] -> [TblUnique]
forall a. a -> [a] -> [a]
: [TblUnique]
uCons)
    genPersistFld :: Field -> Maybe (String, String, FldExtIsMaybe, Maybe String)
genPersistFld (Field (String
_fldName, FldExtIsMaybe
_, Maybe String
_) FldTyp
_fldTyp [ExtTyp]
_) = case FldTyp
_fldTyp of
      FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_ Maybe TblFld
_mTblFld -> case Maybe TblFld
_mTblFld of
        Maybe TblFld
Nothing -> Maybe (String, String, FldExtIsMaybe, Maybe String)
forall a. Maybe a
Nothing
        Just (TblFld TblFldOpaleye
_ FldExtIsMaybe
_ [String]
_ Maybe String
_def) ->
          if String
_fldName String -> String -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== String
"id" FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
&& String
_fldTypS String -> String -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== String
"Int64"
            then Maybe (String, String, FldExtIsMaybe, Maybe String)
forall a. Maybe a
Nothing
            else (String, String, FldExtIsMaybe, Maybe String)
-> Maybe (String, String, FldExtIsMaybe, Maybe String)
forall a. a -> Maybe a
Just (String
_fldName, ShowS
wrapperParens String
_fldTypS, FldExtIsMaybe
_fldBasIsM, Maybe String
_def)
      FldTyp
_ -> Maybe (String, String, FldExtIsMaybe, Maybe String)
forall a. Maybe a
Nothing
    wrapperParens :: ShowS
wrapperParens String
s =
      if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
words String
s) Int -> Int -> FldExtIsMaybe
forall a. Ord a => a -> a -> FldExtIsMaybe
> Int
1
        then String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        else String
s

strPersistTyp :: RepPersistTyp -> Maybe String
strPersistTyp :: RepPersistTyp -> Maybe String
strPersistTyp (String
basTypName, TblPrimary [String]
pNames, [TblUnique]
uCons, [(String, String, FldExtIsMaybe, Maybe String)]
tblFlds) =
  let primaryLine :: Maybe String
primaryLine = if [String] -> FldExtIsMaybe
forall a. [a] -> FldExtIsMaybe
forall (t :: * -> *) a. Foldable t => t a -> FldExtIsMaybe
null [String]
pNames then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Primary" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
pNames
      uniqueLines :: [String]
uniqueLines = [TblUnique]
uCons [TblUnique] -> (TblUnique -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(TblUnique String
uConName [String]
uConFlds) -> [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"Unique" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
uConName) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
uConFlds)
      tblFldLines :: [String]
tblFldLines =
        [(String, String, FldExtIsMaybe, Maybe String)]
tblFlds
          [(String, String, FldExtIsMaybe, Maybe String)]
-> ((String, String, FldExtIsMaybe, Maybe String) -> String)
-> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(String
fldName, String
fldTypS, FldExtIsMaybe
fldBasIsMaybe, Maybe String
mTblFldDef) ->
                  [String] -> String
unwords ([String] -> String)
-> ([Maybe String] -> [String]) -> [Maybe String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> String) -> [Maybe String] -> String
forall a b. (a -> b) -> a -> b
$ [String -> Maybe String
forall a. a -> Maybe a
Just String
fldName, String -> Maybe String
forall a. a -> Maybe a
Just String
fldTypS, if FldExtIsMaybe
fldBasIsMaybe then String -> Maybe String
forall a. a -> Maybe a
Just String
"Maybe" else Maybe String
forall a. Maybe a
Nothing, (String
"default=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mTblFldDef]
              )
   in if [String] -> FldExtIsMaybe
forall a. [a] -> FldExtIsMaybe
forall (t :: * -> *) a. Foldable t => t a -> FldExtIsMaybe
null [String]
tblFldLines
        then Maybe String
forall a. Maybe a
Nothing
        else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
basTypName [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Int -> ShowS
indent Int
1 ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ((String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> [String] -> [Maybe String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
tblFldLines) [Maybe String] -> [Maybe String] -> [Maybe String]
forall a. Semigroup a => a -> a -> a
<> Maybe String -> [Maybe String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
primaryLine [Maybe String] -> [Maybe String] -> [Maybe String]
forall a. Semigroup a => a -> a -> a
<> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> [String] -> [Maybe String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
uniqueLines)))
  where
    indent :: Int -> ShowS
indent Int
n String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'\t' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

decTedious ::
  String ->
  Q [Dec]
decTedious :: String -> Q [Dec]
decTedious String
str = do
  let tts :: [TediousTyp]
tts = case Parser [TediousTyp]
-> String
-> String
-> Either (ParseErrorBundle String Void) [TediousTyp]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser [TediousTyp]
pTediousTyps String
"" String
str of
        Left ParseErrorBundle String Void
b -> String -> [TediousTyp]
forall a. HasCallStack => String -> a
error (String
"parse pTedious : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
b)
        Right [TediousTyp]
tts_ -> [TediousTyp]
tts_
  let repTts :: [(HashMap String RepTediousFields, [String])]
repTts = [TediousTyp]
tts [TediousTyp]
-> (TediousTyp -> (HashMap String RepTediousFields, [String]))
-> [(HashMap String RepTediousFields, [String])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TediousTyp -> (HashMap String RepTediousFields, [String])
repTediousTyp
  let reps :: [(String, [String], RepTediousFields)]
reps = [(HashMap String RepTediousFields, [String])]
repTts [(HashMap String RepTediousFields, [String])]
-> ((HashMap String RepTediousFields, [String])
    -> [(String, [String], RepTediousFields)])
-> [(String, [String], RepTediousFields)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(HashMap String RepTediousFields
m, [String]
devs) -> HashMap String RepTediousFields -> [(String, RepTediousFields)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap String RepTediousFields
m [(String, RepTediousFields)]
-> ((String, RepTediousFields)
    -> (String, [String], RepTediousFields))
-> [(String, [String], RepTediousFields)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(String
n, RepTediousFields
flds) -> (String
n, [String]
devs, RepTediousFields
flds)))
  [Dec]
tediousTypDecs <- [[Dec]] -> [Dec]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, [String], RepTediousFields) -> Q [Dec])
-> [(String, [String], RepTediousFields)] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String, [String], RepTediousFields) -> Q [Dec]
repDec [(String, [String], RepTediousFields)]
reps
  [Dec]
opaleyeDecs <- [[Dec]] -> [Dec]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TediousTyp -> Q [Dec]) -> [TediousTyp] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TediousTyp -> Q [Dec]
decOpaleye [TediousTyp]
tts
  [Dec]
persistDecs <- [TediousTyp] -> Q [Dec]
decPersist [TediousTyp]
tts
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec]
tediousTypDecs [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
opaleyeDecs [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
persistDecs)
  where
    repDec :: TypInfo -> Q [Dec]
    repDec :: (String, [String], RepTediousFields) -> Q [Dec]
repDec (String, [String], RepTediousFields)
typInfo = do
      [Dec]
_decBasic <- (String, [String], RepTediousFields) -> Q [Dec]
decBasic (String, [String], RepTediousFields)
typInfo
      [Dec]
_decShow <- (String, [String], RepTediousFields) -> Q [Dec]
decShow (String, [String], RepTediousFields)
typInfo
      [Dec]
_decEq <- (String, [String], RepTediousFields) -> Q [Dec]
decEq (String, [String], RepTediousFields)
typInfo
      [Dec]
_decGeneric <- (String, [String], RepTediousFields) -> Q [Dec]
decGeneric (String, [String], RepTediousFields)
typInfo
      [Dec]
_decDefault <- (String, [String], RepTediousFields) -> Q [Dec]
decDefault (String, [String], RepTediousFields)
typInfo
      [Dec]
_decJSON <- (String, [String], RepTediousFields) -> Q [Dec]
decJSON (String, [String], RepTediousFields)
typInfo
      [Dec]
_decToSchema <- (String, [String], RepTediousFields) -> Q [Dec]
decToSchema (String, [String], RepTediousFields)
typInfo
      [Dec]
_decLens <- (Dec -> FldExtIsMaybe) -> [Dec] -> [Dec]
forall a. (a -> FldExtIsMaybe) -> [a] -> [a]
dropWhile Dec -> FldExtIsMaybe
isDataD ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensRules -> Q [Dec] -> Q [Dec]
declareLensesWith LensRules
lensRules ([Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec]
_decBasic)
      [Dec]
_decStandaloneDerivs <- (String, [String], RepTediousFields) -> Q [Dec]
decStandaloneDerivs (String, [String], RepTediousFields)
typInfo
      [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec]
_decBasic [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decShow [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decEq [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decGeneric [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decDefault [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decJSON [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decToSchema [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decLens [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
_decStandaloneDerivs

decBasic :: TypInfo -> Q [Dec]
decBasic :: (String, [String], RepTediousFields) -> Q [Dec]
decBasic (String
typName, [String]
_, RepTediousFields
flds) = do
  let name :: Name
name = String -> Name
mkName String
typName
  let vbs :: [Q VarBangType]
vbs =
        RepTediousFields
flds
          RepTediousFields
-> ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
    -> Q VarBangType)
-> [Q VarBangType]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(String
_fldName, Maybe String
_, FldTyp
_fldTyp, FldExtIsMaybe
_fldExtIsM, Maybe String
_mFldExtVar) ->
                  let _fldT :: Q Type
_fldT = case Maybe String
_mFldExtVar of
                        Maybe String
Nothing -> case FldTyp
_fldTyp of
                          FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_ Maybe TblFld
_mTblFld -> Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> FldExtIsMaybe -> Type
strToTyp String
_fldTypS (FldExtIsMaybe
_fldBasIsM FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
|| FldExtIsMaybe
_fldExtIsM)
                          FldTypPoly String
_fldTypVar FldExtIsMaybe
_fldBasIsM -> Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> FldExtIsMaybe -> Type
varToTyp String
_fldTypVar FldExtIsMaybe
_fldBasIsM
                        Just String
_fldExtVar -> Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> FldExtIsMaybe -> Type
varToTyp String
_fldExtVar FldExtIsMaybe
_fldExtIsM
                   in Name -> Q BangType -> Q VarBangType
forall (m :: * -> *).
Quote m =>
Name -> m BangType -> m VarBangType
varBangType (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
lowerFirst String
typName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
upperFirst String
_fldName) (Q Bang -> Q Type -> Q BangType
forall (m :: * -> *). Quote m => m Bang -> m Type -> m BangType
bangType (Q SourceUnpackedness -> Q SourceStrictness -> Q Bang
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang Q SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness Q SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness) Q Type
_fldT)
              )
  let bndrs :: [TyVarBndr ()]
bndrs = [Name -> TyVarBndr ()
plainTV (String -> Name
mkName String
_fldExtVar) | String
_fldExtVar <- ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds]
  let dec :: Q Dec
dec =
        if [Q VarBangType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Q VarBangType]
vbs Int -> Int -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== Int
1
          then
            Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD Q Cxt
forall a. Monoid a => a
mempty Name
name [TyVarBndr ()]
bndrs Maybe Type
forall a. Maybe a
Nothing (Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name [Q VarBangType]
vbs) []
          else
            Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q Cxt
forall a. Monoid a => a
mempty Name
name [TyVarBndr ()]
bndrs Maybe Type
forall a. Maybe a
Nothing [Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name [Q VarBangType]
vbs] []
  Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Dec
dec

decStandaloneDerivs :: TypInfo -> Q [Dec]
decStandaloneDerivs :: (String, [String], RepTediousFields) -> Q [Dec]
decStandaloneDerivs (String
typName, [String]
_devClsNames, RepTediousFields
flds) =
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
    [String]
_devClsNames
      [String] -> (String -> Dec) -> [Dec]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \String
_devClsName ->
              let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
                  preds :: Cxt
preds = [Type -> Type -> Type
AppT (Name -> Type
ConT (String -> Name
mkName String
_devClsName)) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)) | String
_fldExtVar <- [String]
_fldExtVars]
               in Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
forall a. Maybe a
Nothing Cxt
preds (Type -> Type -> Type
AppT (Name -> Type
ConT (String -> Name
mkName String
_devClsName)) (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars))
          )

decShow :: TypInfo -> Q [Dec]
decShow :: (String, [String], RepTediousFields) -> Q [Dec]
decShow (String
typName, [String]
_, RepTediousFields
flds) =
  let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
      preds :: Cxt
preds = [Type -> Type -> Type
AppT (Name -> Type
ConT ''Show) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)) | String
_fldExtVar <- [String]
_fldExtVars]
   in [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> (Dec -> [Dec]) -> Dec -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q [Dec]) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) Cxt
preds (Type -> Type -> Type
AppT (Name -> Type
ConT ''Show) (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars))

decEq :: TypInfo -> Q [Dec]
decEq :: (String, [String], RepTediousFields) -> Q [Dec]
decEq (String
typName, [String]
_, RepTediousFields
flds) =
  let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
      preds :: Cxt
preds = [Type -> Type -> Type
AppT (Name -> Type
ConT ''Eq) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)) | String
_fldExtVar <- [String]
_fldExtVars]
   in [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> (Dec -> [Dec]) -> Dec -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q [Dec]) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) Cxt
preds (Type -> Type -> Type
AppT (Name -> Type
ConT ''Eq) (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars))

decGeneric :: TypInfo -> Q [Dec]
decGeneric :: (String, [String], RepTediousFields) -> Q [Dec]
decGeneric (String
typName, [String]
_, RepTediousFields
flds) =
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> (Dec -> [Dec]) -> Dec -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q [Dec]) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) [] (Type -> Type -> Type
AppT (Name -> Type
ConT ''Generic) (String -> [String] -> Type
typWithVars String
typName (((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds)))

decDefault :: TypInfo -> Q [Dec]
decDefault :: (String, [String], RepTediousFields) -> Q [Dec]
decDefault (String
typName, [String]
_, RepTediousFields
flds) =
  let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
      preds :: Cxt
preds = [Type -> Type -> Type
AppT (Name -> Type
ConT ''Default) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)) | String
_fldExtVar <- [String]
_fldExtVars]
   in [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> (Dec -> [Dec]) -> Dec -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q [Dec]) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
forall a. Maybe a
Nothing Cxt
preds (Type -> Type -> Type
AppT (Name -> Type
ConT ''Default) (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars))

decJSON :: TypInfo -> Q [Dec]
decJSON :: (String, [String], RepTediousFields) -> Q [Dec]
decJSON (String
typName, [String]
_devClsNames, RepTediousFields
flds) = do
  let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
  let _typ :: Type
_typ = String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars
  Dec
decToJSON <- do
    Exp
eToJ <- [|genericToJSON toJSONOptions {A.fieldLabelModifier = trimPrefixName_ typName}|]
    let fToJ :: Dec
fToJ = Name -> [Clause] -> Dec
FunD 'A.toJSON [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
eToJ) []]
    Exp
eToE <- [|genericToEncoding toJSONOptions {A.fieldLabelModifier = trimPrefixName_ typName}|]
    let fToE :: Dec
fToE = Name -> [Clause] -> Dec
FunD 'A.toEncoding [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
eToE) []]
    let preds :: [Cxt]
preds =
          [ [ Type -> Type -> Type
AppT (Name -> Type
ConT ''Generic) Type
_typ,
              Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
ConT ''A.GToJSON') (Name -> Type
ConT ''A.Value)) (Name -> Type
ConT ''A.Zero)) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Rep) Type
_typ),
              Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
ConT ''A.GToJSON') (Name -> Type
ConT ''A.Encoding)) (Name -> Type
ConT ''A.Zero)) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Rep) Type
_typ)
            ]
            | String
_fldExtVar <- [String]
_fldExtVars
          ]
    Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing ([Cxt] -> Cxt
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [Cxt]
preds) (Type -> Type -> Type
AppT (Name -> Type
ConT ''ToJSON) Type
_typ) [Dec
fToJ, Dec
fToE]
  Dec
decFromJSON <- do
    Exp
e <- [|genericParseJSON toJSONOptions {A.fieldLabelModifier = trimPrefixName_ typName}|]
    let preds :: [Cxt]
preds =
          [ [ Type -> Type -> Type
AppT (Name -> Type
ConT ''Generic) Type
_typ,
              Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (Name -> Type
ConT ''A.GFromJSON) (Name -> Type
ConT ''A.Zero)) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Rep) Type
_typ)
              -- AppT (ConT ''FromJSON) (VarT (mkName _fldExtVar))

            ]
            | String
_fldExtVar <- [String]
_fldExtVars
          ]
    Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing ([Cxt] -> Cxt
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [Cxt]
preds) (Type -> Type -> Type
AppT (Name -> Type
ConT ''FromJSON) (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars)) [Name -> [Clause] -> Dec
FunD 'A.parseJSON [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
e) []]]
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
decToJSON, Dec
decFromJSON]

decToSchema :: TypInfo -> Q [Dec]
decToSchema :: (String, [String], RepTediousFields) -> Q [Dec]
decToSchema (String
typName, [String]
_devClsNames, RepTediousFields
flds) = do
  let name :: Name
name = String -> Name
mkName String
typName
  let _fldExtVars :: [String]
_fldExtVars = ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> Maybe String)
-> RepTediousFields -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
-> Maybe String
forall a b. Sel5 a b => a -> b
sel5 RepTediousFields
flds
  let preds :: Cxt
preds =
        [Cxt] -> Cxt
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          [ [ Type -> Type -> Type
AppT (Name -> Type
ConT ''Default) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)),
              Type -> Type -> Type
AppT (Name -> Type
ConT ''ToJSON) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar)),
              Type -> Type -> Type
AppT (Name -> Type
ConT ''ToSchema) (Name -> Type
VarT (String -> Name
mkName String
_fldExtVar))
            ]
            | String
_fldExtVar <- [String]
_fldExtVars
          ]
  let tuples :: [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
tuples =
        ( \(String
_fldName, Maybe String
_mFldTitle, FldTyp
_fldTyp, FldExtIsMaybe
_fldExtIsM, Maybe String
_mFldExtVar) -> do
            let (Type
_fldT, Maybe String
_mFldS) = case Maybe String
_mFldExtVar of
                  Maybe String
Nothing -> case FldTyp
_fldTyp of
                    FldTypNormal String
_fldTypS FldExtIsMaybe
_fldBasIsM Maybe String
_mFldSamp Maybe TblFld
_mTblFld -> (String -> FldExtIsMaybe -> Type
strToTyp String
_fldTypS (FldExtIsMaybe
_fldBasIsM FldExtIsMaybe -> FldExtIsMaybe -> FldExtIsMaybe
|| FldExtIsMaybe
_fldExtIsM), Maybe String
_mFldSamp)
                    FldTypPoly String
_fldTypVar FldExtIsMaybe
_fldBasIsM -> (String -> FldExtIsMaybe -> Type
varToTyp String
_fldTypVar FldExtIsMaybe
_fldBasIsM, Maybe String
forall a. Maybe a
Nothing)
                  Just String
_fldExtVar -> (String -> FldExtIsMaybe -> Type
varToTyp String
_fldExtVar FldExtIsMaybe
_fldExtIsM, Maybe String
forall a. Maybe a
Nothing)
            let sigProxy :: Exp
sigProxy = Exp -> Type -> Exp
SigE (Name -> Exp
ConE 'Proxy) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Proxy) Type
_fldT)
            (String
_fldName, Maybe String
_mFldTitle, Type
_fldT, Type -> FldExtIsMaybe
isMaybeTyp Type
_fldT, Maybe String
_mFldS, Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'declareSchemaRef) Exp
sigProxy)
        )
          ((String, Maybe String, FldTyp, FldExtIsMaybe, Maybe String)
 -> (String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp))
-> RepTediousFields
-> [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RepTediousFields
flds
  let bindStmts :: [Q Stmt]
bindStmts = [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
tuples [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
-> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
    -> Q Stmt)
-> [Q Stmt]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(String
_fldName, Maybe String
_, Type
_, FldExtIsMaybe
_, Maybe String
_, Exp
_schemaRefExp) -> Q Pat -> Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS (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
$ ShowS
fldSchemaName String
_fldName)) (Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
_schemaRefExp))
  let u1 :: Q Exp
u1 = Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'type_) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(L.?~)) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'OpenApiObject)
  let u2 :: Q Exp
u2 =
        Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE
          (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'properties)
          (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(L..~))
          ( Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
              (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'IHM.fromList)
              ( [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$
                  [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
tuples
                    [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
-> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
    -> Q Exp)
-> [Q Exp]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(String
_fldName, Maybe String
_mFldTitle, Type
_, FldExtIsMaybe
_, Maybe String
_, Exp
_fldBasIsM) ->
                            [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE [String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE String
_fldName, Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ ShowS
fldSchemaName String
_fldName)) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(<&>)) (Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'title) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(L..~)) [|_mFldTitle|])]
                        )
              )
          )
  let u3 :: Q Exp
u3 = Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'required) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(L..~)) ([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp)
-> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
    -> String)
-> (String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
-> String
forall a b. Sel1 a b => a -> b
sel1 ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
 -> Q Exp)
-> [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
-> [Q Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
 -> FldExtIsMaybe)
-> [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
-> [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
forall a. (a -> FldExtIsMaybe) -> [a] -> [a]
filter (FldExtIsMaybe -> FldExtIsMaybe
not (FldExtIsMaybe -> FldExtIsMaybe)
-> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
    -> FldExtIsMaybe)
-> (String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
-> FldExtIsMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
-> FldExtIsMaybe
forall a b. Sel4 a b => a -> b
sel4) [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
tuples)
  let sampTup :: Q Exp
sampTup =
        [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$
          [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
tuples
            [(String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)]
-> ((String, Maybe String, Type, FldExtIsMaybe, Maybe String, Exp)
    -> Q Exp)
-> [Q Exp]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(String
_, Maybe String
_, Type
_fldTyp, FldExtIsMaybe
_isMaybeFldTyp, Maybe String
_mFldSamp, Exp
_) ->
                    case Maybe String
_mFldSamp of
                      Maybe String
Nothing -> Q Exp -> Q Type -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
sigE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'def) (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
_fldTyp)
                      Just String
_fldSamp -> Q Exp -> Q Type -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
sigE (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'read) (String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE String
_fldSamp)) (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
_fldTyp)
                )
  let samp :: Q Exp
samp = Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'uncurryN) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
name)) Q Exp
sampTup
  let u4 :: Q Exp
u4 = Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'example) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(L.?~)) (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'toJSON) Q Exp
samp)
  let pureStmt :: Q Stmt
pureStmt =
        Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS
          ( Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
              (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'return)
              ( Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
                  (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'named) (String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE String
typName))
                  (Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'mempty) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(F.&)) Q Exp
u1) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(F.&)) Q Exp
u2) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(F.&)) Q Exp
u3) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(F.&)) Q Exp
u4)
              )
          )
  Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
preds) (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 ''ToSchema) (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> Type
typWithVars String
typName [String]
_fldExtVars))) [Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'O.declareNamedSchema [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB ([Q Stmt] -> Q Exp
forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE ([Q Stmt] -> Q Exp) -> [Q Stmt] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Stmt]
bindStmts [Q Stmt] -> [Q Stmt] -> [Q Stmt]
forall a. Semigroup a => a -> a -> a
<> [Q Stmt
pureStmt])) []]]

decOpaleye :: TediousTyp -> Q [Dec]
decOpaleye :: TediousTyp -> Q [Dec]
decOpaleye (TediousTyp (Combo String
basTypName Maybe TblInfo
mTblInfo Maybe [String]
_) [Field]
flds) = ContT [Dec] Q [Dec] -> Q [Dec]
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT [Dec] Q [Dec] -> Q [Dec]) -> ContT [Dec] Q [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ do
  (([Dec] -> ContT [Dec] Q ()) -> ContT [Dec] Q [Dec])
-> ContT [Dec] Q [Dec]
forall a b.
((a -> ContT [Dec] Q b) -> ContT [Dec] Q a) -> ContT [Dec] Q a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC ((([Dec] -> ContT [Dec] Q ()) -> ContT [Dec] Q [Dec])
 -> ContT [Dec] Q [Dec])
-> (([Dec] -> ContT [Dec] Q ()) -> ContT [Dec] Q [Dec])
-> ContT [Dec] Q [Dec]
forall a b. (a -> b) -> a -> b
$ \[Dec] -> ContT [Dec] Q ()
exit -> do
    let funbasTypName :: String
funbasTypName = ShowS
lowerFirst String
basTypName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Table"
    let tblFlds :: RepOpaleye
tblFlds = [Field] -> RepOpaleye
repOpaleye [Field]
flds
    FldExtIsMaybe -> ContT [Dec] Q () -> ContT [Dec] Q ()
forall (f :: * -> *).
Applicative f =>
FldExtIsMaybe -> f () -> f ()
when (RepOpaleye -> FldExtIsMaybe
forall a. [a] -> FldExtIsMaybe
forall (t :: * -> *) a. Foldable t => t a -> FldExtIsMaybe
null RepOpaleye
tblFlds) (ContT [Dec] Q () -> ContT [Dec] Q ())
-> ContT [Dec] Q () -> ContT [Dec] Q ()
forall a b. (a -> b) -> a -> b
$ [Dec] -> ContT [Dec] Q ()
exit [Dec]
forall a. Monoid a => a
mempty
    let wTyps :: Cxt
wTyps = (String -> FldExtIsMaybe -> Type
`strToTyp` FldExtIsMaybe
False) (String -> Type)
-> ((String, (String, FldExtIsMaybe), String, String) -> String)
-> (String, (String, FldExtIsMaybe), String, String)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String, FldExtIsMaybe), String, String) -> String
forall a b. Sel3 a b => a -> b
sel3 ((String, (String, FldExtIsMaybe), String, String) -> Type)
-> RepOpaleye -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RepOpaleye
tblFlds
    let wFlds :: Q Type
wFlds = Cxt -> Maybe Type -> Q Type
forall {m :: * -> *}. Monad m => Cxt -> Maybe Type -> m Type
genSigFields Cxt
wTyps Maybe Type
forall a. Maybe a
Nothing
    let vTyps :: Cxt
vTyps = (String -> FldExtIsMaybe -> Type
`strToTyp` FldExtIsMaybe
False) (String -> Type)
-> ((String, (String, FldExtIsMaybe), String, String) -> String)
-> (String, (String, FldExtIsMaybe), String, String)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String, FldExtIsMaybe), String, String) -> String
forall a b. Sel4 a b => a -> b
sel4 ((String, (String, FldExtIsMaybe), String, String) -> Type)
-> RepOpaleye -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RepOpaleye
tblFlds
    let vFlds :: Q Type
vFlds = Cxt -> Maybe Type -> Q Type
forall {m :: * -> *}. Monad m => Cxt -> Maybe Type -> m Type
genSigFields Cxt
vTyps Maybe Type
forall a. Maybe a
Nothing
    Dec
sig <- Q Dec -> ContT [Dec] Q Dec
forall (m :: * -> *) a. Monad m => m a -> ContT [Dec] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Dec -> ContT [Dec] Q Dec) -> Q Dec -> ContT [Dec] Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD (String -> Name
mkName String
funbasTypName) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (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 ''Table) Q Type
wFlds) Q Type
vFlds)
    let nFlds :: [String]
nFlds = (String, (String, FldExtIsMaybe), String, String) -> String
forall a b. Sel1 a b => a -> b
sel1 ((String, (String, FldExtIsMaybe), String, String) -> String)
-> RepOpaleye -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RepOpaleye
tblFlds
    let eFlds :: [Q Exp]
eFlds = Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'tableField) (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> (String -> Lit) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
stringL (String -> Q Exp) -> [String] -> [Q Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
nFlds
    Dec
fun <-
      Q Dec -> ContT [Dec] Q Dec
forall (m :: * -> *) a. Monad m => m a -> ContT [Dec] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Dec -> ContT [Dec] Q Dec) -> Q Dec -> ContT [Dec] Q Dec
forall a b. (a -> b) -> a -> b
$
        Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
          (String -> Name
mkName String
funbasTypName)
          [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              []
              ( Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
                  ( Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
                      (String -> Maybe TblInfo -> Q Exp
forall {m :: * -> *}. Quote m => String -> Maybe TblInfo -> m Exp
appTable String
basTypName Maybe TblInfo
mTblInfo)
                      (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"p" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([String] -> Int) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
nFlds))) ([Q Exp] -> Q Exp
forall {m :: * -> *}. (Quote m, MonadFail m) => [m Exp] -> m Exp
genFunFields [Q Exp]
eFlds))
                  )
              )
              []
          ]
    [Dec] -> ContT [Dec] Q [Dec]
forall a. a -> ContT [Dec] Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
sig, Dec
fun]
  where
    genSigFields :: Cxt -> Maybe Type -> m Type
genSigFields (Type
t : Cxt
ts) Maybe Type
Nothing = Cxt -> Maybe Type -> m Type
genSigFields Cxt
ts (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ if Cxt -> FldExtIsMaybe
forall a. [a] -> FldExtIsMaybe
forall (t :: * -> *) a. Foldable t => t a -> FldExtIsMaybe
null Cxt
ts then Type
t else Type -> Type -> Type
AppT (Int -> Type
TupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$ Cxt -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Type
t)
    genSigFields (Type
t : Cxt
ts) (Just Type
t') = Cxt -> Maybe Type -> m Type
genSigFields Cxt
ts (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Type -> Type
AppT Type
t' Type
t))
    genSigFields [] (Just Type
t') = Type -> m Type
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t'
    genSigFields [] Maybe Type
Nothing = Type -> m Type
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ''()
    genFunFields :: [m Exp] -> m Exp
genFunFields [m Exp]
es | [m Exp] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m Exp]
es Int -> Int -> FldExtIsMaybe
forall a. Ord a => a -> a -> FldExtIsMaybe
> Int
1 = [m Exp] -> m Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
tupE [m Exp]
es
    genFunFields [m Exp
e] = m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp
parensE m Exp
e
    genFunFields [m Exp]
_ = String -> m Exp
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"makeTable : empty flds"
    appTable :: String -> Maybe TblInfo -> m Exp
appTable String
basTypName_ Maybe TblInfo
mTblInfo_ = case Maybe TblInfo
mTblInfo_ of
      Maybe TblInfo
Nothing -> m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'table) (Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
basTypName_))
      Just (TblInfoQualified String
tblSchema_ String
tblName_) -> m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'tableWithSchema) (Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
tblSchema_))) (Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
tblName_))
      Just (TblInfoUnQualified String
tblName_) -> m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'table) (Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
tblName_))

decPersist :: [TediousTyp] -> Q [Dec]
decPersist :: [TediousTyp] -> Q [Dec]
decPersist [TediousTyp]
tts = do
  let unboundEntityDefs :: String
unboundEntityDefs = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (TediousTyp -> Maybe String) -> [TediousTyp] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RepPersistTyp -> Maybe String
strPersistTyp (RepPersistTyp -> Maybe String)
-> (TediousTyp -> RepPersistTyp) -> TediousTyp -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TediousTyp -> RepPersistTyp
repPersistTyp) [TediousTyp]
tts
  let name_ :: Name
name_ = String -> Name
mkName String
"tediousPersistString"
  Dec
sigD_ <- Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
name_ (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''String)
  Dec
valD_ <- Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
name_) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (String -> Lit
stringL String
unboundEntityDefs))) []
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
sigD_, Dec
valD_]

strToTyp :: String -> Bool -> Type
strToTyp :: String -> FldExtIsMaybe -> Type
strToTyp String
s FldExtIsMaybe
m =
  let ot :: Type
ot = (String -> Type) -> (Type -> Type) -> Either String Type -> Type
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> Type
forall a. HasCallStack => String -> a
error String
"decTedious: cannot parse field type") Type -> Type
forall a. a -> a
id (String -> Either String Type
parseType String
s)
   in if FldExtIsMaybe
m then Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) Type
ot else Type
ot

varToTyp :: String -> Bool -> Type
varToTyp :: String -> FldExtIsMaybe -> Type
varToTyp String
s FldExtIsMaybe
m =
  let ot :: Type
ot = Name -> Type
VarT (String -> Name
mkName String
s)
   in if FldExtIsMaybe
m then Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) Type
ot else Type
ot

typWithVars :: TypName -> [FldExtVar] -> Type
typWithVars :: String -> [String] -> Type
typWithVars String
name = Type -> [String] -> Type
go (Name -> Type
ConT (String -> Name
mkName String
name))
  where
    go :: Type -> [String] -> Type
go Type
t [] = Type
t
    go Type
t (String
var : [String]
vars) = Type -> [String] -> Type
go (Type -> Type -> Type
AppT Type
t (Name -> Type
VarT (String -> Name
mkName String
var))) [String]
vars

isMaybeTyp :: Type -> Bool
isMaybeTyp :: Type -> FldExtIsMaybe
isMaybeTyp (AppT (ConT Name
c) Type
_)
  | Name
c Name -> Name -> FldExtIsMaybe
forall a. Eq a => a -> a -> FldExtIsMaybe
== ''Maybe = FldExtIsMaybe
True
  | FldExtIsMaybe
otherwise = FldExtIsMaybe
False
isMaybeTyp Type
_ = FldExtIsMaybe
False

isDataD :: Dec -> Bool
isDataD :: Dec -> FldExtIsMaybe
isDataD DataD {} = FldExtIsMaybe
True
isDataD NewtypeD {} = FldExtIsMaybe
True
isDataD Dec
_ = FldExtIsMaybe
False

fldSchemaName :: FldName -> String
fldSchemaName :: ShowS
fldSchemaName = (String
"schema" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
upperFirst

--


{-
> :set -XTemplateHaskell
> $(stringE . show =<< reify ''Hello)
> parseTest pName "Hello"
-}