{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Database.MySQL.Hasqlator.Typed.Schema
  (TableInfo(..), ColumnInfo(..), fetchTableInfo, Sign(..), ColumnType(..),
   pprTableInfo, Properties(..), defaultProperties, makeFields,
   smartUpcase, smartDowncase,
   makeRecords, makeSelectors, makeInsertors) where
import Database.MySQL.Hasqlator
import qualified Database.MySQL.Hasqlator.Typed as T
import Database.MySQL.Base(MySQLConn)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import Text.Megaparsec
import qualified Data.Map as Map
import qualified Data.Set as Set
import Text.Megaparsec.Char
import Data.Text (Text)
import Control.Applicative (liftA2)
import Language.Haskell.TH
import Data.Word
import Data.Int
import Data.Scientific
import Data.Time
import qualified Data.ByteString as StrictBS
import Data.Aeson(Value)
import Data.Char
import GHC.TypeLits(Symbol)
import Text.Pretty.Simple

data Sign = Signed | Unsigned
  deriving Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show

data ColumnType =
  TinyIntColumn Sign |
  SmallIntColumn Sign |
  MediumIntColumn Sign |
  IntColumn Sign |
  BigIntColumn Sign |
  DecimalColumn Int Int Sign |
  VarCharColumn Int |
  CharColumn Int |
  TextColumn |
  BlobColumn |
  DateTimeColumn Int |
  TimestampColumn Int |
  DateColumn |
  TimeColumn Int |
  DoubleColumn |
  FloatColumn |
  EnumColumn [Text] |
  SetColumn [Text] |
  BinaryColumn Int |
  VarBinaryColumn Int | 
  BitColumn Int |
  JsonColumn
  deriving (Int -> ColumnType -> ShowS
[ColumnType] -> ShowS
ColumnType -> String
(Int -> ColumnType -> ShowS)
-> (ColumnType -> String)
-> ([ColumnType] -> ShowS)
-> Show ColumnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnType] -> ShowS
$cshowList :: [ColumnType] -> ShowS
show :: ColumnType -> String
$cshow :: ColumnType -> String
showsPrec :: Int -> ColumnType -> ShowS
$cshowsPrec :: Int -> ColumnType -> ShowS
Show)

data ColumnInfo = ColumnInfo
  { ColumnInfo -> Text
columnTableSchema :: Text
  , ColumnInfo -> Text
columnTableName :: Text
  , ColumnInfo -> Text
columnName :: Text
  , ColumnInfo -> ColumnType
columnType :: ColumnType
  , ColumnInfo -> Bool
columnNullable :: Bool
  , ColumnInfo -> Bool
primaryKey :: Bool
  , ColumnInfo -> Bool
autoIncrement :: Bool
  , ColumnInfo -> Maybe (Text, Text, Text)
foreignKey :: Maybe (Text, Text, Text)
  } deriving (Int -> ColumnInfo -> ShowS
[ColumnInfo] -> ShowS
ColumnInfo -> String
(Int -> ColumnInfo -> ShowS)
-> (ColumnInfo -> String)
-> ([ColumnInfo] -> ShowS)
-> Show ColumnInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnInfo] -> ShowS
$cshowList :: [ColumnInfo] -> ShowS
show :: ColumnInfo -> String
$cshow :: ColumnInfo -> String
showsPrec :: Int -> ColumnInfo -> ShowS
$cshowsPrec :: Int -> ColumnInfo -> ShowS
Show)

data TableInfo = TableInfo
  { TableInfo -> Text
tableName :: Text
  , TableInfo -> Text
tableSchema :: Text
  , TableInfo -> [ColumnInfo]
tableColumns :: [ColumnInfo]
  } deriving (Int -> TableInfo -> ShowS
[TableInfo] -> ShowS
TableInfo -> String
(Int -> TableInfo -> ShowS)
-> (TableInfo -> String)
-> ([TableInfo] -> ShowS)
-> Show TableInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableInfo] -> ShowS
$cshowList :: [TableInfo] -> ShowS
show :: TableInfo -> String
$cshow :: TableInfo -> String
showsPrec :: Int -> TableInfo -> ShowS
$cshowsPrec :: Int -> TableInfo -> ShowS
Show)

argsP :: Parsec () Text a -> Parsec () Text [a]
argsP :: Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text a
p = ParsecT () Text Identity Char
-> ParsecT () Text Identity Char
-> Parsec () Text [a]
-> Parsec () Text [a]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'(') (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
')') (Parsec () Text [a] -> Parsec () Text [a])
-> Parsec () Text [a] -> Parsec () Text [a]
forall a b. (a -> b) -> a -> b
$ Parsec () Text a
-> ParsecT () Text Identity Char -> Parsec () Text [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parsec () Text a
p (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
',')

arg1P :: Parsec () Text a -> Parsec () Text a
arg1P :: Parsec () Text a -> Parsec () Text a
arg1P = ParsecT () Text Identity Char
-> ParsecT () Text Identity Char
-> Parsec () Text a
-> Parsec () Text a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'(') (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
')')

arg2P :: Parsec () Text a -> Parsec () Text (a, a)
arg2P :: Parsec () Text a -> Parsec () Text (a, a)
arg2P Parsec () Text a
p = ParsecT () Text Identity Char
-> ParsecT () Text Identity Char
-> Parsec () Text (a, a)
-> Parsec () Text (a, a)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'(') (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
')') (Parsec () Text (a, a) -> Parsec () Text (a, a))
-> Parsec () Text (a, a) -> Parsec () Text (a, a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> (a, a))
-> Parsec () Text a -> Parsec () Text a -> Parsec () Text (a, a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Parsec () Text a
p (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
',' ParsecT () Text Identity Char
-> Parsec () Text a -> Parsec () Text a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec () Text a
p)

stringP :: Parsec () Text Text
stringP :: Parsec () Text Text
stringP = (String -> Text)
-> ParsecT () Text Identity String -> Parsec () Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (ParsecT () Text Identity String -> Parsec () Text Text)
-> ParsecT () Text Identity String -> Parsec () Text Text
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity Char
-> ParsecT () Text Identity Char
-> ParsecT () Text Identity String
-> ParsecT () Text Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'\'') (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'\'') (ParsecT () Text Identity String
 -> ParsecT () Text Identity String)
-> ParsecT () Text Identity String
-> ParsecT () Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT () Text Identity Char -> ParsecT () Text Identity String)
-> ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall a b. (a -> b) -> a -> b
$
          [Token Text] -> ParsecT () Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'\'', Char
'\\'] ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'\\' ParsecT () Text Identity Char
-> ParsecT () Text Identity Char -> ParsecT () Text Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT () Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)

intP :: Parsec () Text Int
intP :: Parsec () Text Int
intP = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT () Text Identity String -> Parsec () Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT () Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

signP :: Parsec () Text Sign
signP :: Parsec () Text Sign
signP = Sign -> Parsec () Text Sign -> Parsec () Text Sign
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Sign
Signed (Parsec () Text Sign -> Parsec () Text Sign)
-> Parsec () Text Sign -> Parsec () Text Sign
forall a b. (a -> b) -> a -> b
$ Sign
Unsigned Sign -> Parsec () Text Text -> Parsec () Text Sign
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"unsigned"

parseType :: Text -> ColumnType
parseType :: Text -> ColumnType
parseType Text
t = case Parsec () Text ColumnType
-> String -> Text -> Either (ParseErrorBundle Text ()) ColumnType
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec () Text ColumnType
typeParser String
"COLUMN_TYPE" Text
t of
  Left ParseErrorBundle Text ()
err -> String -> ColumnType
forall a. HasCallStack => String -> a
error (String -> ColumnType) -> String -> ColumnType
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text () -> String
forall a. Show a => a -> String
show ParseErrorBundle Text ()
err
  Right ColumnType
res -> ColumnType
res

typeParser :: Parsec () Text ColumnType
typeParser :: Parsec () Text ColumnType
typeParser = do
  String
typename <- ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT () Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
  case String
typename of
    -- ignore the "display width" argument
    String
"tinyint" -> (Sign -> ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sign -> ColumnType
TinyIntColumn (Parsec () Text Sign -> Parsec () Text ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity [Int]
-> ParsecT () Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec () Text Int -> ParsecT () Text Identity [Int]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Int
intP) ParsecT () Text Identity (Maybe [Int])
-> ParsecT () Text Identity () -> ParsecT () Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT () Text Identity ()
-> Parsec () Text Sign -> Parsec () Text Sign
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text Sign
signP
    String
"smallint" -> (Sign -> ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sign -> ColumnType
SmallIntColumn (Parsec () Text Sign -> Parsec () Text ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity [Int]
-> ParsecT () Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec () Text Int -> ParsecT () Text Identity [Int]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Int
intP) ParsecT () Text Identity (Maybe [Int])
-> ParsecT () Text Identity () -> ParsecT () Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT () Text Identity ()
-> Parsec () Text Sign -> Parsec () Text Sign
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text Sign
signP
    String
"mediumint" -> (Sign -> ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sign -> ColumnType
MediumIntColumn (Parsec () Text Sign -> Parsec () Text ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity [Int]
-> ParsecT () Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec () Text Int -> ParsecT () Text Identity [Int]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Int
intP) ParsecT () Text Identity (Maybe [Int])
-> ParsecT () Text Identity () -> ParsecT () Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT () Text Identity ()
-> Parsec () Text Sign -> Parsec () Text Sign
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text Sign
signP
    String
"int" -> (Sign -> ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sign -> ColumnType
IntColumn (Parsec () Text Sign -> Parsec () Text ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity [Int]
-> ParsecT () Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec () Text Int -> ParsecT () Text Identity [Int]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Int
intP) ParsecT () Text Identity (Maybe [Int])
-> ParsecT () Text Identity () -> ParsecT () Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT () Text Identity ()
-> Parsec () Text Sign -> Parsec () Text Sign
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text Sign
signP
    String
"bigint" -> (Sign -> ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sign -> ColumnType
BigIntColumn (Parsec () Text Sign -> Parsec () Text ColumnType)
-> Parsec () Text Sign -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ ParsecT () Text Identity [Int]
-> ParsecT () Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parsec () Text Int -> ParsecT () Text Identity [Int]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Int
intP) ParsecT () Text Identity (Maybe [Int])
-> ParsecT () Text Identity () -> ParsecT () Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT () Text Identity ()
-> Parsec () Text Sign -> Parsec () Text Sign
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec () Text Sign
signP
    String
"decimal" -> do (Int
m, Int
d) <- Parsec () Text Int -> Parsec () Text (Int, Int)
forall a. Parsec () Text a -> Parsec () Text (a, a)
arg2P Parsec () Text Int
intP
                    ParsecT () Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
                    Sign
sign <- Parsec () Text Sign
signP
                    pure $ Int -> Int -> Sign -> ColumnType
DecimalColumn Int
m Int
d Sign
sign
    String
"varchar" -> Int -> ColumnType
VarCharColumn (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"char" -> Int -> ColumnType
CharColumn (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"tinytext" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
TextColumn
    String
"text" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
TextColumn
    String
"mediumtext" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
TextColumn
    String
"longtext" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
TextColumn
    String
"tinyblob" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
BlobColumn
    String
"blob" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
BlobColumn
    String
"mediumblob" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
BlobColumn
    String
"longblob" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
BlobColumn
    String
"datetime" -> (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ColumnType
DateTimeColumn (Parsec () Text Int -> Parsec () Text ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ Int -> Parsec () Text Int -> Parsec () Text Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 (Parsec () Text Int -> Parsec () Text Int)
-> Parsec () Text Int -> Parsec () Text Int
forall a b. (a -> b) -> a -> b
$ Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"date" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
DateColumn 
    String
"time" -> (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ColumnType
TimeColumn (Parsec () Text Int -> Parsec () Text ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ Int -> Parsec () Text Int -> Parsec () Text Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 (Parsec () Text Int -> Parsec () Text Int)
-> Parsec () Text Int -> Parsec () Text Int
forall a b. (a -> b) -> a -> b
$ Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"timestamp" -> (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ColumnType
TimestampColumn (Parsec () Text Int -> Parsec () Text ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ Int -> Parsec () Text Int -> Parsec () Text Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 (Parsec () Text Int -> Parsec () Text Int)
-> Parsec () Text Int -> Parsec () Text Int
forall a b. (a -> b) -> a -> b
$ Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"float" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
FloatColumn
    String
"double" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
DoubleColumn
    String
"enum" -> [Text] -> ColumnType
EnumColumn ([Text] -> ColumnType)
-> ParsecT () Text Identity [Text] -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Text
stringP
    String
"set" -> [Text] -> ColumnType
SetColumn ([Text] -> ColumnType)
-> ParsecT () Text Identity [Text] -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Text -> ParsecT () Text Identity [Text]
forall a. Parsec () Text a -> Parsec () Text [a]
argsP Parsec () Text Text
stringP
    String
"binary" -> Int -> ColumnType
VarBinaryColumn (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"varbinary" -> Int -> ColumnType
VarBinaryColumn (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
"json" -> ColumnType -> Parsec () Text ColumnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnType
JsonColumn
    String
"bit" -> Int -> ColumnType
BitColumn (Int -> ColumnType)
-> Parsec () Text Int -> Parsec () Text ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec () Text Int -> Parsec () Text Int
forall a. Parsec () Text a -> Parsec () Text a
arg1P Parsec () Text Int
intP
    String
x -> String -> Parsec () Text ColumnType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec () Text ColumnType)
-> String -> Parsec () Text ColumnType
forall a b. (a -> b) -> a -> b
$ String
"Don't know how to parse COLUMN_TYPE " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
x

tableQuery :: [Text] -> Query TableInfo
tableQuery :: [Text] -> Query TableInfo
tableQuery [Text]
schemas =
  Selector TableInfo -> QueryClauses -> Query TableInfo
forall a. Selector a -> QueryClauses -> Query a
select Selector TableInfo
tableSelector (QueryClauses -> Query TableInfo)
-> QueryClauses -> Query TableInfo
forall a b. (a -> b) -> a -> b
$
  QueryBuilder -> QueryClauses
from QueryBuilder
"information_schema.TABLES" QueryClauses -> QueryClauses -> QueryClauses
forall a. Semigroup a => a -> a -> a
<>
  [QueryBuilder] -> QueryClauses
where_ [QueryBuilder
"TABLE_SCHEMA" QueryBuilder -> [QueryBuilder] -> QueryBuilder
`in_` (Text -> QueryBuilder) -> [Text] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> QueryBuilder
forall a. ToSql a => a -> QueryBuilder
arg [Text]
schemas]
  where tableSelector :: Selector TableInfo
tableSelector = do
          Text
tableName_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"TABLE_NAME"
          Text
tableSchema_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"TABLE_SCHEMA"
          pure $ TableInfo :: Text -> Text -> [ColumnInfo] -> TableInfo
TableInfo{ tableName :: Text
tableName = Text
tableName_
                          , tableSchema :: Text
tableSchema = Text
tableSchema_
                          , tableColumns :: [ColumnInfo]
tableColumns = []}
  
columnsQuery :: [Text] -> Query ColumnInfo
columnsQuery :: [Text] -> Query ColumnInfo
columnsQuery [Text]
schemas =
  Selector ColumnInfo -> QueryClauses -> Query ColumnInfo
forall a. Selector a -> QueryClauses -> Query a
select Selector ColumnInfo
columnSelector (QueryClauses -> Query ColumnInfo)
-> QueryClauses -> Query ColumnInfo
forall a b. (a -> b) -> a -> b
$
  QueryBuilder -> QueryClauses
from (QueryBuilder
"information_schema.COLUMNS" `as` QueryBuilder
"c")
  QueryClauses -> QueryClauses -> QueryClauses
forall a. Semigroup a => a -> a -> a
<> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
leftJoin [QueryBuilder
"information_schema.KEY_COLUMN_USAGE" `as` QueryBuilder
"k"]
  [ QueryBuilder
"k.TABLE_SCHEMA" QueryBuilder -> QueryBuilder -> QueryBuilder
=. QueryBuilder
"c.TABLE_SCHEMA"
  , QueryBuilder
"k.TABLE_NAME" QueryBuilder -> QueryBuilder -> QueryBuilder
=. QueryBuilder
"c.TABLE_NAME"
  , QueryBuilder
"k.COLUMN_NAME" QueryBuilder -> QueryBuilder -> QueryBuilder
=. QueryBuilder
"c.COLUMN_NAME"
  , QueryBuilder
"k.REFERENCED_COLUMN_NAME IS NOT NULL" 
  ]
  QueryClauses -> QueryClauses -> QueryClauses
forall a. Semigroup a => a -> a -> a
<> [QueryBuilder] -> QueryClauses
where_ [QueryBuilder
"c.TABLE_SCHEMA" QueryBuilder -> [QueryBuilder] -> QueryBuilder
`in_` (Text -> QueryBuilder) -> [Text] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> QueryBuilder
forall a. ToSql a => a -> QueryBuilder
arg [Text]
schemas]
  where columnSelector :: Selector ColumnInfo
columnSelector = do
          Text
tableName_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.TABLE_NAME"
          Text
tableSchema_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.TABLE_SCHEMA"
          Text
columnName_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.COLUMN_NAME"
          Text
nullable <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.IS_NULLABLE"
          Text
columnType_ <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.COLUMN_TYPE"
          Text
columnKey <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.COLUMN_KEY"
          Text
extra <- QueryBuilder -> Selector Text
textSel QueryBuilder
"c.EXTRA"
          Maybe Text
referencedTableSchema <-
            QueryBuilder -> Selector (Maybe Text)
forall a. FromSql a => QueryBuilder -> Selector a
sel QueryBuilder
"k.REFERENCED_TABLE_SCHEMA" :: Selector (Maybe Text)
          Maybe Text
referencedTableName <- 
            QueryBuilder -> Selector (Maybe Text)
forall a. FromSql a => QueryBuilder -> Selector a
sel QueryBuilder
"k.REFERENCED_TABLE_NAME" :: Selector (Maybe Text)
          Maybe Text
referencedColumnName <- 
            QueryBuilder -> Selector (Maybe Text)
forall a. FromSql a => QueryBuilder -> Selector a
sel QueryBuilder
"k.REFERENCED_COLUMN_NAME" :: Selector (Maybe Text)
          pure $ ColumnInfo :: Text
-> Text
-> Text
-> ColumnType
-> Bool
-> Bool
-> Bool
-> Maybe (Text, Text, Text)
-> ColumnInfo
ColumnInfo
            { columnTableSchema :: Text
columnTableSchema = Text
tableSchema_
            , columnTableName :: Text
columnTableName = Text
tableName_
            , columnType :: ColumnType
columnType = Text -> ColumnType
parseType Text
columnType_
            , columnName :: Text
columnName = Text
columnName_
            , columnNullable :: Bool
columnNullable = Text
nullable Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"YES"
            , primaryKey :: Bool
primaryKey = Text
columnKey Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"PRI"
            , autoIncrement :: Bool
autoIncrement = Text
"auto_increment" Text -> Text -> Bool
`Text.isInfixOf` Text
extra
            , foreignKey :: Maybe (Text, Text, Text)
foreignKey = (,,)
                           (Text -> Text -> Text -> (Text, Text, Text))
-> Maybe Text -> Maybe (Text -> Text -> (Text, Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
referencedTableSchema
                           Maybe (Text -> Text -> (Text, Text, Text))
-> Maybe Text -> Maybe (Text -> (Text, Text, Text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
referencedTableName
                           Maybe (Text -> (Text, Text, Text))
-> Maybe Text -> Maybe (Text, Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
referencedColumnName
            }

-- | Fetch TableInfo structures for each of the given schemas, using
-- the given `MySQLConn` connection.
fetchTableInfo :: MySQLConn -> [Text] -> IO [TableInfo]
fetchTableInfo :: MySQLConn -> [Text] -> IO [TableInfo]
fetchTableInfo MySQLConn
conn [Text]
schemas = do
  [TableInfo]
tables <- MySQLConn -> Query TableInfo -> IO [TableInfo]
forall a. MySQLConn -> Query a -> IO [a]
executeQuery MySQLConn
conn (Query TableInfo -> IO [TableInfo])
-> Query TableInfo -> IO [TableInfo]
forall a b. (a -> b) -> a -> b
$ [Text] -> Query TableInfo
tableQuery [Text]
schemas
  [ColumnInfo]
columns <- MySQLConn -> Query ColumnInfo -> IO [ColumnInfo]
forall a. MySQLConn -> Query a -> IO [a]
executeQuery MySQLConn
conn (Query ColumnInfo -> IO [ColumnInfo])
-> Query ColumnInfo -> IO [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ [Text] -> Query ColumnInfo
columnsQuery [Text]
schemas
  let columnMap :: Map (Text, Text) [ColumnInfo]
columnMap = ([ColumnInfo] -> [ColumnInfo] -> [ColumnInfo])
-> [((Text, Text), [ColumnInfo])] -> Map (Text, Text) [ColumnInfo]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [ColumnInfo] -> [ColumnInfo] -> [ColumnInfo]
forall a. [a] -> [a] -> [a]
(++) ([((Text, Text), [ColumnInfo])] -> Map (Text, Text) [ColumnInfo])
-> [((Text, Text), [ColumnInfo])] -> Map (Text, Text) [ColumnInfo]
forall a b. (a -> b) -> a -> b
$
                  (ColumnInfo -> ((Text, Text), [ColumnInfo]))
-> [ColumnInfo] -> [((Text, Text), [ColumnInfo])]
forall a b. (a -> b) -> [a] -> [b]
map (\ColumnInfo
ci -> ( (ColumnInfo -> Text
columnTableSchema ColumnInfo
ci, ColumnInfo -> Text
columnTableName ColumnInfo
ci)
                              , [ColumnInfo
ci]))
                  [ColumnInfo]
columns
  pure $
    (TableInfo -> TableInfo) -> [TableInfo] -> [TableInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\tbl :: TableInfo
tbl@TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName, Text
tableSchema :: Text
tableSchema :: TableInfo -> Text
tableSchema} ->
           TableInfo
tbl {tableColumns :: [ColumnInfo]
tableColumns = [ColumnInfo]
-> (Text, Text) -> Map (Text, Text) [ColumnInfo] -> [ColumnInfo]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (Text
tableSchema, Text
tableName)
                               Map (Text, Text) [ColumnInfo]
columnMap} )
    [TableInfo]
tables

pprTableInfo :: LazyText.Text -> [TableInfo] -> LazyText.Text
pprTableInfo :: Text -> [TableInfo] -> Text
pprTableInfo Text
name [TableInfo]
ti =
  [Text] -> Text
LazyText.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
  (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
LazyText.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [TableInfo] -> Text
forall a. Show a => a -> Text
pShowNoColor [TableInfo]
ti

columnTHType :: Bool -> ColumnInfo -> Q Type
columnTHType :: Bool -> ColumnInfo -> Q Type
columnTHType Bool
ignoreMaybe ColumnInfo{ ColumnType
columnType :: ColumnType
columnType :: ColumnInfo -> ColumnType
columnType, Bool
columnNullable :: Bool
columnNullable :: ColumnInfo -> Bool
columnNullable}
  | Bool
columnNullable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ignoreMaybe = [t| Maybe $(tp) |]
  | Bool
otherwise = Q Type
tp
  where tp :: Q Type
tp = case ColumnType
columnType of
          TinyIntColumn Sign
_  -> [t| Int |]
          SmallIntColumn Sign
_ -> [t| Int |]
          MediumIntColumn Sign
_ -> [t| Int |]
          IntColumn Sign
_ -> [t| Int |]
          BigIntColumn Sign
Signed -> [t| Int64 |]
          BigIntColumn Sign
Unsigned -> [t| Word64 |]
          DecimalColumn{} -> [t| Scientific |]
          VarCharColumn Int
_ -> [t| Text |]
          CharColumn Int
_ -> [t| Text |]
          ColumnType
TextColumn -> [t| Text |]
          DateTimeColumn Int
_ -> [t| LocalTime |]
          TimestampColumn Int
_ -> [t| LocalTime |]
          ColumnType
DateColumn -> [t| Day |]
          TimeColumn Int
_ -> [t| TimeOfDay |]
          ColumnType
DoubleColumn -> [t| Double |]
          ColumnType
FloatColumn -> [t| Float |]
          EnumColumn [Text]
_ -> [t| Text |]
          SetColumn [Text]
_ -> [t| Text |]
          BinaryColumn Int
_ -> [t| StrictBS.ByteString |]
          VarBinaryColumn Int
_ -> [t| StrictBS.ByteString |]
          ColumnType
BlobColumn -> [t| StrictBS.ByteString |]
          BitColumn Int
_ -> [t| Word64 |]
          ColumnType
JsonColumn -> [t| Value |]

data Properties = Properties
  { Properties -> ColumnInfo -> String
fieldNameModifier :: ColumnInfo -> String
  , Properties -> TableInfo -> String
tableNameModifier :: TableInfo -> String
  , Properties -> ShowS
classNameModifier :: String -> String
  , Properties -> Bool
includeSchema :: Bool
  , Properties -> TableInfo -> String
insertorTypeModifier :: TableInfo -> String
  , Properties -> TableInfo -> String
insertorNameModifier :: TableInfo -> String
  , Properties -> TableInfo -> String
selectorNameModifier :: TableInfo -> String
  , Properties -> String
fieldsQualifier :: String
  , Properties -> ColumnInfo -> String
insertorFieldModifier :: ColumnInfo -> String
  }


smartDowncase :: String -> String
smartDowncase :: ShowS
smartDowncase (Char
c:String
cs)
  | Char -> Bool
isAlpha Char
c = let (String
l, String
r) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
                in (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r
  | Bool
otherwise = Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
smartDowncase String
"" = String
""

smartUpcase :: String -> String
smartUpcase :: ShowS
smartUpcase (Char
c:String
cs)
  | Char -> Bool
isAlpha Char
c = Char -> Char
toUpper Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
  | Bool
otherwise = Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
smartUpcase String
"" = String
""

removeUnderscore :: String -> String
removeUnderscore :: ShowS
removeUnderscore (Char
'_':Char
c:String
cs)
  | Char -> Bool
isAlpha Char
c = Char -> Char
toUpper Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
removeUnderscore String
cs
removeUnderscore (Char
c:String
cs) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
removeUnderscore String
cs
removeUnderscore [] = []

defaultProperties :: Properties
defaultProperties :: Properties
defaultProperties = Properties :: (ColumnInfo -> String)
-> (TableInfo -> String)
-> ShowS
-> Bool
-> (TableInfo -> String)
-> (TableInfo -> String)
-> (TableInfo -> String)
-> String
-> (ColumnInfo -> String)
-> Properties
Properties
  { fieldNameModifier :: ColumnInfo -> String
fieldNameModifier = \ColumnInfo{Text
columnName :: Text
columnName :: ColumnInfo -> Text
columnName} ->
      let n :: String
n = Text -> String
Text.unpack Text
columnName
      in ShowS
smartDowncase String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if ShowS
smartDowncase String
n String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reserved then String
"_" else String
forall a. Monoid a => a
mempty)
  , tableNameModifier :: TableInfo -> String
tableNameModifier = \TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName} ->
      let n :: String
n = Text -> String
Text.unpack Text
tableName
      in ShowS
smartDowncase String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
         (if ShowS
smartDowncase String
n String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reserved then String
"_" else String
forall a. Monoid a => a
mempty) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_tbl"
  , classNameModifier :: ShowS
classNameModifier = \String
n -> String
"Has_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_field"
  , includeSchema :: Bool
includeSchema = Bool
True
  , insertorTypeModifier :: TableInfo -> String
insertorTypeModifier = \TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName} ->
      let n :: String
n = Text -> String
Text.unpack Text
tableName
      in ShowS
removeUnderscore (ShowS
smartUpcase String
n) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Fields"
  , insertorNameModifier :: TableInfo -> String
insertorNameModifier = \TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName} ->
      let n :: String
n = Text -> String
Text.unpack Text
tableName
      in ShowS
smartDowncase (ShowS
removeUnderscore String
n) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Insertor"
  , selectorNameModifier :: TableInfo -> String
selectorNameModifier = \TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName} ->
      let n :: String
n = Text -> String
Text.unpack Text
tableName
      in String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_sel"
  , fieldsQualifier :: String
fieldsQualifier = String
""
  , insertorFieldModifier :: ColumnInfo -> String
insertorFieldModifier = \ColumnInfo{Text
columnName :: Text
columnName :: ColumnInfo -> Text
columnName} ->
      let n :: String
n = Text -> String
Text.unpack Text
columnName
      in ShowS
smartDowncase String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_field"
  }
    where reserved :: [String]
          reserved :: [String]
reserved = [String
"id", String
"class", String
"data", String
"type", String
"foreign", String
"import",
                      String
"default", String
"case"]

getColumnTableName :: Properties -> ColumnInfo -> String
getColumnTableName :: Properties -> ColumnInfo -> String
getColumnTableName Properties{Bool
includeSchema :: Bool
includeSchema :: Properties -> Bool
includeSchema}
                   ColumnInfo{Text
columnTableSchema :: Text
columnTableSchema :: ColumnInfo -> Text
columnTableSchema, Text
columnTableName :: Text
columnTableName :: ColumnInfo -> Text
columnTableName}
  | Bool
includeSchema = Text -> String
Text.unpack Text
columnTableSchema String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                    Text -> String
Text.unpack Text
columnTableName
  | Bool
otherwise = Text -> String
Text.unpack Text
columnTableName
          
getTableName :: Properties -> TableInfo -> String
getTableName :: Properties -> TableInfo -> String
getTableName Properties{Bool
includeSchema :: Bool
includeSchema :: Properties -> Bool
includeSchema}
             TableInfo{Text
tableSchema :: Text
tableSchema :: TableInfo -> Text
tableSchema, Text
tableName :: Text
tableName :: TableInfo -> Text
tableName}
  | Bool
includeSchema = Text -> String
Text.unpack Text
tableSchema String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                    Text -> String
Text.unpack Text
tableName
  | Bool
otherwise = Text -> String
Text.unpack Text
tableName
          
makeField :: Properties -> Name -> ColumnInfo -> Q [Dec]
makeField :: Properties -> Name -> ColumnInfo -> Q [Dec]
makeField Properties
props Name
dbName ci :: ColumnInfo
ci@ColumnInfo{Text
columnName :: Text
columnName :: ColumnInfo -> Text
columnName
                                    ,Bool
columnNullable :: Bool
columnNullable :: ColumnInfo -> Bool
columnNullable} =
  [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name -> Q Type -> Q Dec
sigD
             (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> ColumnInfo -> String
fieldNameModifier Properties
props ColumnInfo
ci)
             [t| T.Field
                 $(litT $ strTyLit tableName)
                 $(conT dbName)
                 $(if columnNullable
                    then promotedT 'T.Nullable
                    else promotedT 'T.NotNull)
                 $(columnTHType True ci)
               |]
           , PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP (Name -> PatQ) -> Name -> PatQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> ColumnInfo -> String
fieldNameModifier Properties
props ColumnInfo
ci)
             (ExpQ -> BodyQ
normalB [e| T.Field
                          $(litE $ stringL tableName)
                          $(litE $ stringL fieldName)
                        |])
             []
           ]
  where tableName :: String
tableName = Properties -> ColumnInfo -> String
getColumnTableName Properties
props ColumnInfo
ci
        fieldName :: String
fieldName = Text -> String
Text.unpack Text
columnName
        
makeTable :: Properties -> Name -> TableInfo -> Q [Dec]
makeTable :: Properties -> Name -> TableInfo -> Q [Dec]
makeTable props :: Properties
props@Properties{TableInfo -> String
tableNameModifier :: TableInfo -> String
tableNameModifier :: Properties -> TableInfo -> String
tableNameModifier, Bool
includeSchema :: Bool
includeSchema :: Properties -> Bool
includeSchema}
          Name
dbname
          ti :: TableInfo
ti@TableInfo{Text
tableName :: Text
tableName :: TableInfo -> Text
tableName, Text
tableSchema :: Text
tableSchema :: TableInfo -> Text
tableSchema} =
  [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name -> Q Type -> Q Dec
sigD
             (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ TableInfo -> String
tableNameModifier TableInfo
ti)
             [t| T.Table
                 $(litT $ strTyLit $ getTableName props ti)
                 $(conT dbname)
               |]
           , PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP (Name -> PatQ) -> Name -> PatQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ TableInfo -> String
tableNameModifier TableInfo
ti)
             (ExpQ -> BodyQ
normalB [e| T.Table
                          $(if includeSchema
                            then appE (conE 'Just) $
                                 litE $ stringL $ Text.unpack tableSchema
                            else conE 'Nothing)
                          $(litE $ stringL tableString)
                        |])
             []
           ]
  where tableString :: String
tableString = Text -> String
Text.unpack Text
tableName
           
fieldClass :: Properties -> Name -> String -> Q Dec
fieldClass :: Properties -> Name -> String -> Q Dec
fieldClass Properties
props Name
dbName String
columnName =
  CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [Q Dec] -> Q Dec
classD ([Type] -> CxtQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> ShowS
classNameModifier Properties
props String
columnName)
    [ Name -> Type -> TyVarBndr
kindedTV (String -> Name
mkName String
"table") (Name -> Type
ConT ''Symbol)
    , Name -> Type -> TyVarBndr
kindedTV (String -> Name
mkName String
"nullable") (Name -> Type
ConT ''T.Nullable)
    , Name -> TyVarBndr
plainTV (Name -> TyVarBndr) -> Name -> TyVarBndr
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"a"]
    [[Name] -> [Name] -> FunDep
FunDep [String -> Name
mkName String
"table"] [String -> Name
mkName String
"nullable", String -> Name
mkName String
"a"]]
    [ Name -> Q Type -> Q Dec
sigD
      (String -> Name
mkName String
columnName)
      [t| T.Field
          $(varT $ mkName "table")
          $(conT dbName)
          $(varT $ mkName "nullable")
          $(varT $ mkName "a")
        |]]

fieldInstance :: Properties -> ColumnInfo -> Q Dec
fieldInstance :: Properties -> ColumnInfo -> Q Dec
fieldInstance Properties
props ci :: ColumnInfo
ci@ColumnInfo{Text
columnName :: Text
columnName :: ColumnInfo -> Text
columnName,
                                  Bool
columnNullable :: Bool
columnNullable :: ColumnInfo -> Bool
columnNullable} =
  CxtQ -> Q Type -> [Q Dec] -> Q Dec
instanceD ([Type] -> CxtQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  [t| $(conT $ mkName $ classNameModifier props $ fieldNameModifier props ci)
      $(litT $ strTyLit tableName)
      $(promotedT $ if columnNullable then 'T.Nullable else 'T.NotNull)
      $(columnTHType True ci)
      |]
  [PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP (Name -> PatQ) -> Name -> PatQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> ColumnInfo -> String
fieldNameModifier Properties
props ColumnInfo
ci)
             (ExpQ -> BodyQ
normalB [e| T.Field
                          $(litE $ stringL tableName)
                          $(litE $ stringL fieldName)
                        |])
             []]
    where fieldName :: String
fieldName = Text -> String
Text.unpack Text
columnName
          tableName :: String
tableName = Properties -> ColumnInfo -> String
getColumnTableName Properties
props ColumnInfo
ci

  
insertorType :: Properties -> TableInfo -> Q Dec
insertorType :: Properties -> TableInfo -> Q Dec
insertorType Properties
props TableInfo
ti =
  CxtQ
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [ConQ]
-> [DerivClauseQ]
-> Q Dec
dataD ([Type] -> CxtQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  (String -> Name
mkName String
typeName)
  []
  Maybe Type
forall a. Maybe a
Nothing
  [Name -> [VarBangTypeQ] -> ConQ
recC (String -> Name
mkName String
typeName) ([VarBangTypeQ] -> ConQ) -> [VarBangTypeQ] -> ConQ
forall a b. (a -> b) -> a -> b
$ (ColumnInfo -> VarBangTypeQ) -> [ColumnInfo] -> [VarBangTypeQ]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo -> VarBangTypeQ
columnTypes ([ColumnInfo] -> [VarBangTypeQ]) -> [ColumnInfo] -> [VarBangTypeQ]
forall a b. (a -> b) -> a -> b
$ TableInfo -> [ColumnInfo]
tableColumns TableInfo
ti ]
  []
  where typeName :: String
typeName = Properties -> TableInfo -> String
insertorTypeModifier Properties
props TableInfo
ti
        columnTypes :: ColumnInfo -> VarBangTypeQ
columnTypes ColumnInfo
ci =
          ( String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> ColumnInfo -> String
insertorFieldModifier Properties
props ColumnInfo
ci
          , SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness
          ,
          ) (Type -> (Name, Bang, Type)) -> Q Type -> VarBangTypeQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ColumnInfo -> Q Type
columnTHType Bool
False ColumnInfo
ci

insertor :: Properties -> Name -> TableInfo -> Q [Dec]
insertor :: Properties -> Name -> TableInfo -> Q [Dec]
insertor Properties
props Name
dbName TableInfo
ti =
  [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name -> Q Type -> Q Dec
sigD
             Name
insertorName
             [t| T.Insertor
                 $(litT $ strTyLit $ getTableName props ti)
                 $(conT dbName)
                 $(conT insertorTypeName)
                 |]
           , PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP Name
insertorName)
             (ExpQ -> BodyQ
normalB (ExpQ -> BodyQ) -> ExpQ -> BodyQ
forall a b. (a -> b) -> a -> b
$ (ExpQ -> ExpQ -> ExpQ) -> [ExpQ] -> ExpQ
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ExpQ
x ExpQ
y -> [| $(x) <> $(y) |]) ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$
              (ColumnInfo -> ExpQ) -> [ColumnInfo] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo -> ExpQ
insertorField ([ColumnInfo] -> [ExpQ]) -> [ColumnInfo] -> [ExpQ]
forall a b. (a -> b) -> a -> b
$ TableInfo -> [ColumnInfo]
tableColumns TableInfo
ti)
             []
           ]
  where 
    insertorName :: Name
insertorName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> TableInfo -> String
insertorNameModifier Properties
props TableInfo
ti
    insertorTypeName :: Name
insertorTypeName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> TableInfo -> String
insertorTypeModifier Properties
props TableInfo
ti 
    insertorField :: ColumnInfo -> Q Exp
    insertorField :: ColumnInfo -> ExpQ
insertorField ColumnInfo
ci = [e| $(sigE
                             (varE $ mkName $ insertorFieldModifier props ci)
                             [t| $(conT insertorTypeName) ->
                                 $(columnTHType False ci)  |])
                           `T.into`
                           $(varE $ mkName $
                             fieldsQualifier props <>
                             fieldNameModifier props ci) |]

makeSelector :: Properties -> Name -> TableInfo -> Q [Dec]
makeSelector :: Properties -> Name -> TableInfo -> Q [Dec]
makeSelector Properties
props Name
dbName TableInfo
ti =
  [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name -> Q Type -> Q Dec
sigD
             Name
selectorName
             [t| T.Tbl
                 $(litT $ strTyLit $ getTableName props ti)
                 $(conT dbName)
                 'T.InnerJoined
                 ->
                 T.Selector
                 $(conT insertorTypeName)
                 |]
           , Name -> [ClauseQ] -> Q Dec
funD Name
selectorName
             [ do Name
alias <- String -> Q Name
newName String
"alias"
                  [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
clause [Name -> [PatQ] -> PatQ
conP 'T.Tbl [Name -> PatQ
varP Name
alias]]
                    (ExpQ -> BodyQ
normalB (ExpQ -> BodyQ) -> ExpQ -> BodyQ
forall a b. (a -> b) -> a -> b
$ Name -> ExpQ
tableSelector Name
alias)
                    []
             ]]

  where selectorName :: Name
selectorName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> TableInfo -> String
selectorNameModifier Properties
props TableInfo
ti
        insertorTypeName :: Name
insertorTypeName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Properties -> TableInfo -> String
insertorTypeModifier Properties
props TableInfo
ti
        tableSelector :: Name -> ExpQ
tableSelector Name
alias =
          case (ColumnInfo -> ExpQ) -> [ColumnInfo] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> ColumnInfo -> ExpQ
fieldSelector Name
alias) ([ColumnInfo] -> [ExpQ]) -> [ColumnInfo] -> [ExpQ]
forall a b. (a -> b) -> a -> b
$ TableInfo -> [ColumnInfo]
tableColumns TableInfo
ti of
            [] -> [e| pure $(conE $ mkName $ insertorTypeModifier props ti) |]
            (ExpQ
sel1:[ExpQ]
sels) -> (ExpQ -> ExpQ -> ExpQ) -> ExpQ -> [ExpQ] -> ExpQ
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                           (\ExpQ
s1 ExpQ
s2 -> [e| $(s1) <*> $(s2) |])
                           [e| $(conE $ mkName $ insertorTypeModifier props ti)
                               <$> $(sel1) |]
                           [ExpQ]
sels
        fieldSelector :: Name -> ColumnInfo -> ExpQ
fieldSelector Name
alias ColumnInfo
ci =
          [e| $(if columnNullable ci then [e| T.selMaybe |] else [e| T.sel |])
              ($(varE alias) $(varE $ mkName $
                               fieldsQualifier props <>
                               fieldNameModifier props ci))
            |]

makeFields :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeFields :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeFields Properties
props Name
dbName [TableInfo]
tis =
  ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++) Q [Dec]
classDecs (Q [Dec] -> Q [Dec]) -> Q [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableInfo -> Q [Dec]) -> [TableInfo] -> Q [[Dec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TableInfo -> Q [Dec]
tableDecs [TableInfo]
tis
  where
    classDecs :: Q [Dec]
    classDecs :: Q [Dec]
classDecs = (String -> Q Dec) -> [String] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> Name -> String -> Q Dec
fieldClass Properties
props Name
dbName) ([String] -> Q [Dec]) -> [String] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Set String -> [String]
forall a. Set a -> [a]
Set.toList Set String
duplicateCols

    tableDecs :: TableInfo -> Q [Dec]
    tableDecs :: TableInfo -> Q [Dec]
tableDecs TableInfo
ti = [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Q [Dec]] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      [ Properties -> Name -> TableInfo -> Q [Dec]
makeTable Properties
props Name
dbName TableInfo
ti
      , ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ (ColumnInfo -> Q [Dec]) -> [ColumnInfo] -> Q [[Dec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> Name -> ColumnInfo -> Q [Dec]
makeField Properties
props Name
dbName) ([ColumnInfo] -> Q [[Dec]]) -> [ColumnInfo] -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$
        (ColumnInfo -> Bool) -> [ColumnInfo] -> [ColumnInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ColumnInfo -> Bool) -> ColumnInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
duplicateCol (String -> Bool) -> (ColumnInfo -> String) -> ColumnInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo -> String
getFieldName) ([ColumnInfo] -> [ColumnInfo]) -> [ColumnInfo] -> [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ TableInfo -> [ColumnInfo]
tableColumns TableInfo
ti
      , (ColumnInfo -> Q Dec) -> [ColumnInfo] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> ColumnInfo -> Q Dec
fieldInstance Properties
props) ([ColumnInfo] -> Q [Dec]) -> [ColumnInfo] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ (ColumnInfo -> Bool) -> [ColumnInfo] -> [ColumnInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
duplicateCol (String -> Bool) -> (ColumnInfo -> String) -> ColumnInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo -> String
getFieldName) ([ColumnInfo] -> [ColumnInfo]) -> [ColumnInfo] -> [ColumnInfo]
forall a b. (a -> b) -> a -> b
$
        TableInfo -> [ColumnInfo]
tableColumns TableInfo
ti
      ]

    getFieldName :: ColumnInfo -> String
    getFieldName :: ColumnInfo -> String
getFieldName ColumnInfo
ti = Properties -> ColumnInfo -> String
fieldNameModifier Properties
props ColumnInfo
ti

    duplicateCols :: Set.Set String
    duplicateCols :: Set String
duplicateCols = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall a b. (a, b) -> a
fst ([(String, Int)] -> [String]) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Bool) -> [(String, Int)] -> [(String, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ((String, Int) -> Int) -> (String, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> Int
forall a b. (a, b) -> b
snd) ([(String, Int)] -> [(String, Int)])
-> [(String, Int)] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ Map String Int -> [(String, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String Int -> [(String, Int)])
-> Map String Int -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$
                    (Int -> Int -> Int) -> [(String, Int)] -> Map String Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([(String, Int)] -> Map String Int)
-> [(String, Int)] -> Map String Int
forall a b. (a -> b) -> a -> b
$
                    (ColumnInfo -> (String, Int)) -> [ColumnInfo] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\ColumnInfo
c -> (ColumnInfo -> String
getFieldName ColumnInfo
c, Int
1 :: Int)) ([ColumnInfo] -> [(String, Int)])
-> [ColumnInfo] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$
                    [TableInfo]
tis [TableInfo] -> (TableInfo -> [ColumnInfo]) -> [ColumnInfo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TableInfo -> [ColumnInfo]
tableColumns
    duplicateCol :: String -> Bool
    duplicateCol :: String -> Bool
duplicateCol String
c = String
c String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
duplicateCols

makeRecords :: Properties -> [TableInfo] -> Q [Dec]
makeRecords :: Properties -> [TableInfo] -> Q [Dec]
makeRecords Properties
props = (TableInfo -> Q Dec) -> [TableInfo] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> TableInfo -> Q Dec
insertorType Properties
props)

makeInsertors :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeInsertors :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeInsertors Properties
props Name
dbName [TableInfo]
tis =
  [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableInfo -> Q [Dec]) -> [TableInfo] -> Q [[Dec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> Name -> TableInfo -> Q [Dec]
insertor Properties
props Name
dbName) [TableInfo]
tis

makeSelectors :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeSelectors :: Properties -> Name -> [TableInfo] -> Q [Dec]
makeSelectors Properties
props Name
dbName [TableInfo]
tis =
  [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableInfo -> Q [Dec]) -> [TableInfo] -> Q [[Dec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Properties -> Name -> TableInfo -> Q [Dec]
makeSelector Properties
props Name
dbName) [TableInfo]
tis