module IHP.SchemaCompiler
( compile
, compileStatementPreview
) where
import ClassyPrelude
import Data.String.Conversions (cs)
import Data.String.Interpolate (i)
import IHP.NameSupport (tableNameToModelName, columnNameToFieldName, enumValueToControllerName, pluralize)
import qualified Data.Text as Text
import qualified System.Directory as Directory
import Data.List.Split
import IHP.HaskellSupport
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner
import IHP.IDE.SchemaDesigner.Types
import qualified IHP.IDE.SchemaDesigner.Compiler as SqlCompiler
import qualified Control.Exception as Exception
import NeatInterpolation
data CompileException = CompileException ByteString deriving (Int -> CompileException -> ShowS
[CompileException] -> ShowS
CompileException -> [Char]
(Int -> CompileException -> ShowS)
-> (CompileException -> [Char])
-> ([CompileException] -> ShowS)
-> Show CompileException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileException -> ShowS
showsPrec :: Int -> CompileException -> ShowS
$cshow :: CompileException -> [Char]
show :: CompileException -> [Char]
$cshowList :: [CompileException] -> ShowS
showList :: [CompileException] -> ShowS
Show)
instance Exception CompileException where
displayException :: CompileException -> [Char]
displayException (CompileException ByteString
message) = ByteString -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
message
compile :: IO ()
compile :: IO ()
compile = do
let options :: CompilerOptions
options = CompilerOptions
fullCompileOptions
IO (Either ByteString [Statement])
SchemaDesigner.parseSchemaSql IO (Either ByteString [Statement])
-> (Either ByteString [Statement] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ByteString
parserError -> CompileException -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (ByteString -> CompileException
CompileException ByteString
parserError)
Right [Statement]
statements -> do
Bool -> [Char] -> IO ()
Directory.createDirectoryIfMissing Bool
True [Char]
"build/Generated"
[([Char], Text)] -> (Element [([Char], Text)] -> IO ()) -> IO ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forEach (CompilerOptions -> Schema -> [([Char], Text)]
compileModules CompilerOptions
options ([Statement] -> Schema
Schema [Statement]
statements)) \([Char]
path, Text
body) -> do
[Char] -> Text -> IO ()
writeIfDifferent [Char]
path Text
body
compileModules :: CompilerOptions -> Schema -> [(FilePath, Text)]
compileModules :: CompilerOptions -> Schema -> [([Char], Text)]
compileModules CompilerOptions
options Schema
schema =
[ ([Char]
"build/Generated/Enums.hs", CompilerOptions -> Schema -> Text
compileEnums CompilerOptions
options Schema
schema)
, ([Char]
"build/Generated/ActualTypes.hs", CompilerOptions -> Schema -> Text
compileTypes CompilerOptions
options Schema
schema)
] [([Char], Text)] -> [([Char], Text)] -> [([Char], Text)]
forall a. Semigroup a => a -> a -> a
<> CompilerOptions -> Schema -> [([Char], Text)]
tableModules CompilerOptions
options Schema
schema [([Char], Text)] -> [([Char], Text)] -> [([Char], Text)]
forall a. Semigroup a => a -> a -> a
<>
[ ([Char]
"build/Generated/Types.hs", Schema -> Text
compileIndex Schema
schema)
]
tableModules :: CompilerOptions -> Schema -> [(FilePath, Text)]
tableModules :: CompilerOptions -> Schema -> [([Char], Text)]
tableModules CompilerOptions
options Schema
schema =
let ?schema = ?schema::Schema
Schema
schema
in
Schema
schema.statements
[Statement]
-> ([Statement] -> [([Char], Text)]) -> [([Char], Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Statement -> Maybe ([Char], Text))
-> [Statement] -> [([Char], Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
StatementCreateTable CreateTable
t | CreateTable -> Bool
tableHasPrimaryKey CreateTable
t -> ([Char], Text) -> Maybe ([Char], Text)
forall a. a -> Maybe a
Just ((?schema::Schema) =>
CompilerOptions -> CreateTable -> ([Char], Text)
CompilerOptions -> CreateTable -> ([Char], Text)
tableModule CompilerOptions
options CreateTable
t)
Statement
otherwise -> Maybe ([Char], Text)
forall a. Maybe a
Nothing
)
tableModule :: (?schema :: Schema) => CompilerOptions -> CreateTable -> (FilePath, Text)
tableModule :: (?schema::Schema) =>
CompilerOptions -> CreateTable -> ([Char], Text)
tableModule CompilerOptions
options CreateTable
table =
([Char]
"build/Generated/" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
tableNameToModelName CreateTable
table.name) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
".hs", Text
body)
where
body :: Text
body = [Text] -> Text
Text.unlines
[ Text
prelude
, (?schema::Schema) => CompilerOptions -> CreateTable -> Text
CompilerOptions -> CreateTable -> Text
tableModuleBody CompilerOptions
options CreateTable
table
]
moduleName :: Text
moduleName = Text
"Generated." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName CreateTable
table.name
prelude :: Text
prelude = [trimming|
-- This file is auto generated and will be overriden regulary. Please edit `Application/Schema.sql` to change the Types\n"
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, TypeFamilies, DataKinds, TypeOperators, UndecidableInstances, ConstraintKinds, StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-dodgy-imports -Wno-unused-matches #-}
module $moduleName where
$defaultImports
import Generated.ActualTypes
|]
tableModuleBody :: (?schema :: Schema) => CompilerOptions -> CreateTable -> Text
tableModuleBody :: (?schema::Schema) => CompilerOptions -> CreateTable -> Text
tableModuleBody CompilerOptions
options CreateTable
table = [Text] -> Text
Text.unlines
[ CreateTable -> Text
compileInputValueInstance CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileFromRowInstance CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileGetModelName CreateTable
table
, CreateTable -> Text
compileCreate CreateTable
table
, CreateTable -> Text
compileUpdate CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileBuild CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileFilterPrimaryKeyInstance CreateTable
table
, if CreateTable -> Bool
needsHasFieldId CreateTable
table
then (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileHasFieldId CreateTable
table
else Text
""
, if CompilerOptions
options.compileGetAndSetFieldInstances
then (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileSetFieldInstances CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileUpdateFieldInstances CreateTable
table
else Text
""
]
newtype Schema = Schema { Schema -> [Statement]
statements :: [Statement] }
data CompilerOptions = CompilerOptions {
CompilerOptions -> Bool
compileGetAndSetFieldInstances :: Bool
}
fullCompileOptions :: CompilerOptions
fullCompileOptions :: CompilerOptions
fullCompileOptions = CompilerOptions { $sel:compileGetAndSetFieldInstances:CompilerOptions :: Bool
compileGetAndSetFieldInstances = Bool
True }
previewCompilerOptions :: CompilerOptions
previewCompilerOptions :: CompilerOptions
previewCompilerOptions = CompilerOptions { $sel:compileGetAndSetFieldInstances:CompilerOptions :: Bool
compileGetAndSetFieldInstances = Bool
False }
atomicType :: PostgresType -> Text
atomicType :: PostgresType -> Text
atomicType = \case
PostgresType
PSmallInt -> Text
"Int"
PostgresType
PInt -> Text
"Int"
PostgresType
PBigInt -> Text
"Integer"
PostgresType
PJSONB -> Text
"Data.Aeson.Value"
PostgresType
PText -> Text
"Text"
PostgresType
PBoolean -> Text
"Bool"
PostgresType
PTimestampWithTimezone -> Text
"UTCTime"
PostgresType
PUUID -> Text
"UUID"
PostgresType
PSerial -> Text
"Int"
PostgresType
PBigserial -> Text
"Integer"
PostgresType
PReal -> Text
"Float"
PostgresType
PDouble -> Text
"Double"
PostgresType
PDate -> Text
"Data.Time.Calendar.Day"
PostgresType
PBinary -> Text
"(Binary ByteString)"
PostgresType
PTime -> Text
"TimeOfDay"
(PInterval Maybe Text
_) -> Text
"PGInterval"
PCustomType Text
theType -> Text -> Text
tableNameToModelName Text
theType
PostgresType
PTimestamp -> Text
"LocalTime"
(PNumeric Maybe Int
_ Maybe Int
_) -> Text
"Scientific"
(PVaryingN Maybe Int
_) -> Text
"Text"
(PCharacterN Int
_) -> Text
"Text"
PArray PostgresType
type_ -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PostgresType -> Text
atomicType PostgresType
type_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
PostgresType
PPoint -> Text
"Point"
PostgresType
PPolygon -> Text
"Polygon"
PostgresType
PInet -> Text
"Net.IP.IP"
PostgresType
PTSVector -> Text
"TSVector"
haskellType :: (?schema :: Schema) => CreateTable -> Column -> Text
haskellType :: (?schema::Schema) => CreateTable -> Column -> Text
haskellType table :: CreateTable
table@CreateTable { $sel:name:CreateTable :: CreateTable -> Text
name = Text
tableName, PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint } column :: Column
column@Column { Text
name :: Text
$sel:name:Column :: Column -> Text
name, PostgresType
columnType :: PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType, Bool
notNull :: Bool
$sel:notNull:Column :: Column -> Bool
notNull, Maybe ColumnGenerator
generator :: Maybe ColumnGenerator
$sel:generator:Column :: Column -> Maybe ColumnGenerator
generator }
| [Text
name] [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
primaryKeyTypeName Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
| Bool
otherwise =
let
actualType :: Text
actualType =
case (?schema::Schema) => CreateTable -> Column -> Maybe Constraint
CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint CreateTable
table Column
column of
Just (ForeignKeyConstraint { Text
referenceTable :: Text
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable }) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
primaryKeyTypeName Text
referenceTable Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Maybe Constraint
_ -> PostgresType -> Text
atomicType PostgresType
columnType
in
if Bool -> Bool
not Bool
notNull Bool -> Bool -> Bool
|| Maybe ColumnGenerator -> Bool
forall a. Maybe a -> Bool
isJust Maybe ColumnGenerator
generator
then Text
"(Maybe " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actualType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
else Text
actualType
writeIfDifferent :: FilePath -> Text -> IO ()
writeIfDifferent :: [Char] -> Text -> IO ()
writeIfDifferent [Char]
path Text
content = do
Bool
alreadyExists <- [Char] -> IO Bool
Directory.doesFileExist [Char]
path
ByteString
existingContent <- if Bool
alreadyExists then [Char] -> IO ByteString
forall (m :: * -> *). MonadIO m => [Char] -> m ByteString
readFile [Char]
path else ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
existingContent ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
content) do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Updating " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [Char]
path
[Char] -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => [Char] -> ByteString -> m ()
writeFile (ShowS
forall a b. ConvertibleStrings a b => a -> b
cs [Char]
path) (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
content)
compileTypes :: CompilerOptions -> Schema -> Text
compileTypes :: CompilerOptions -> Schema -> Text
compileTypes CompilerOptions
options schema :: Schema
schema@(Schema [Statement]
statements) = [Text] -> Text
Text.unlines
[ Text
prelude
, let ?schema = ?schema::Schema
Schema
schema in Text
(?schema::Schema) => Text
body
]
where
body :: (?schema :: Schema) => Text
body :: (?schema::Schema) => Text
body =
[Statement]
statements
[Statement] -> ([Statement] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Statement -> Maybe Text) -> [Statement] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
StatementCreateTable CreateTable
table | CreateTable -> Bool
tableHasPrimaryKey CreateTable
table -> Text -> Maybe Text
forall a. a -> Maybe a
Just ((?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileActualTypesForTable CreateTable
table)
Statement
otherwise -> Maybe Text
forall a. Maybe a
Nothing
)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
Text.intercalate Text
"\n\n"
prelude :: Text
prelude = [trimming|
-- This file is auto generated and will be overriden regulary. Please edit `Application/Schema.sql` to change the Types\n"
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, TypeFamilies, DataKinds, TypeOperators, UndecidableInstances, ConstraintKinds, StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-dodgy-imports -Wno-unused-matches #-}
module Generated.ActualTypes (module Generated.ActualTypes, module Generated.Enums) where
$defaultImports
import Generated.Enums
|]
compileActualTypesForTable :: (?schema :: Schema) => CreateTable -> Text
compileActualTypesForTable :: (?schema::Schema) => CreateTable -> Text
compileActualTypesForTable CreateTable
table = [Text] -> Text
Text.unlines
[ (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileData CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compilePrimaryKeyInstance CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileInclude CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypeAlias CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileHasTableNameInstance CreateTable
table
, CreateTable -> Text
compileDefaultIdInstance CreateTable
table
, (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTableInstance CreateTable
table
]
compileIndex :: Schema -> Text
compileIndex :: Schema -> Text
compileIndex Schema
schema = [trimming|
-- This file is auto generated and will be overriden regulary. Please edit `Application/Schema.sql` to change the Types\n"
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, TypeFamilies, DataKinds, TypeOperators, UndecidableInstances, ConstraintKinds, StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-dodgy-imports -Wno-unused-matches #-}
module Generated.Types ($rexports) where
import Generated.ActualTypes
$tableModuleImports
|]
where
tableModuleNames :: [Text]
tableModuleNames =
Schema
schema.statements
[Statement] -> ([Statement] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Statement -> Maybe Text) -> [Statement] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
StatementCreateTable CreateTable
table -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Generated." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName CreateTable
table.name)
Statement
otherwise -> Maybe Text
forall a. Maybe a
Nothing
)
tableModuleImports :: Text
tableModuleImports = [Text]
tableModuleNames
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
name -> Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
Text.unlines
rexportedModules :: [Text]
rexportedModules = [Text
"Generated.ActualTypes"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
tableModuleNames
rexports :: Text
rexports = [Text]
rexportedModules
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
moduleName -> Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
moduleName)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
Text.intercalate Text
", "
defaultImports :: Text
defaultImports = [trimming|
import IHP.HaskellSupport
import IHP.ModelSupport
import CorePrelude hiding (id)
import Data.Time.Clock
import Data.Time.LocalTime
import qualified Data.Time.Calendar
import qualified Data.List as List
import qualified Data.ByteString as ByteString
import qualified Net.IP
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.FromField hiding (Field, name)
import Database.PostgreSQL.Simple.ToField hiding (Field)
import qualified IHP.Controller.Param
import GHC.TypeLits
import Data.UUID (UUID)
import Data.Default
import qualified IHP.QueryBuilder as QueryBuilder
import qualified Data.Proxy
import GHC.Records
import Data.Data
import qualified Data.String.Conversions
import qualified Data.Text.Encoding
import qualified Data.Aeson
import Database.PostgreSQL.Simple.Types (Query (Query), Binary ( .. ))
import qualified Database.PostgreSQL.Simple.Types
import IHP.Job.Types
import IHP.Job.Queue ()
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Dynamic
import Data.Scientific
|]
compileEnums :: CompilerOptions -> Schema -> Text
compileEnums :: CompilerOptions -> Schema -> Text
compileEnums CompilerOptions
options schema :: Schema
schema@(Schema [Statement]
statements) = [Text] -> Text
Text.unlines
[ Text
prelude
, let ?schema = ?schema::Schema
Schema
schema
in Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
"\n\n" ((Statement -> Maybe Text) -> [Statement] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (?schema::Schema) => Statement -> Maybe Text
Statement -> Maybe Text
compileStatement [Statement]
statements)
]
where
compileStatement :: Statement -> Maybe Text
compileStatement enum :: Statement
enum@(CreateEnumType {}) = Text -> Maybe Text
forall a. a -> Maybe a
Just ((?schema::Schema) => Statement -> Text
Statement -> Text
compileEnumDataDefinitions Statement
enum)
compileStatement Statement
_ = Maybe Text
forall a. Maybe a
Nothing
prelude :: Text
prelude = [trimming|
-- This file is auto generated and will be overriden regulary. Please edit `Application/Schema.sql` to change the Types\n"
module Generated.Enums where
import CorePrelude
import IHP.ModelSupport
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromField hiding (Field, name)
import Database.PostgreSQL.Simple.ToField hiding (Field)
import qualified IHP.Controller.Param
import Data.Default
import qualified IHP.QueryBuilder as QueryBuilder
import qualified Data.String.Conversions
import qualified Data.Text.Encoding
import qualified Control.DeepSeq as DeepSeq
|]
compileStatementPreview :: [Statement] -> Statement -> Text
compileStatementPreview :: [Statement] -> Statement -> Text
compileStatementPreview [Statement]
statements Statement
statement =
let ?schema = [Statement] -> Schema
Schema [Statement]
statements
in
case Statement
statement of
CreateEnumType {} -> (?schema::Schema) => Statement -> Text
Statement -> Text
compileEnumDataDefinitions Statement
statement
StatementCreateTable CreateTable
table -> [Text] -> Text
Text.unlines
[ (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileActualTypesForTable CreateTable
table
, (?schema::Schema) => CompilerOptions -> CreateTable -> Text
CompilerOptions -> CreateTable -> Text
tableModuleBody CompilerOptions
previewCompilerOptions CreateTable
table
]
tableHasPrimaryKey :: CreateTable -> Bool
tableHasPrimaryKey :: CreateTable -> Bool
tableHasPrimaryKey CreateTable
table = CreateTable
table.primaryKeyConstraint PrimaryKeyConstraint -> PrimaryKeyConstraint -> Bool
forall a. Eq a => a -> a -> Bool
/= ([Text] -> PrimaryKeyConstraint
PrimaryKeyConstraint [])
compileTypeAlias :: (?schema :: Schema) => CreateTable -> Text
compileTypeAlias :: (?schema::Schema) => CreateTable -> Text
compileTypeAlias table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) =
Text
"type "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((?schema::Schema) => CreateTable -> Column -> Text
CreateTable -> Column -> Text
haskellType CreateTable
table) ((?schema::Schema) => CreateTable -> [Column]
CreateTable -> [Column]
variableAttributes CreateTable
table))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hasManyDefaults
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
hasManyDefaults :: Text
hasManyDefaults = (?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable Text
name
[(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
tableName, Text
columnName) -> Text
"(QueryBuilder.QueryBuilder \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")")
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords
primaryKeyTypeName :: Text -> Text
primaryKeyTypeName :: Text -> Text
primaryKeyTypeName Text
name = Text
"Id' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
""
compileData :: (?schema :: Schema) => CreateTable -> Text
compileData :: (?schema::Schema) => CreateTable -> Text
compileData table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) =
Text
"data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeArguments
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
CreateTable
table
CreateTable -> (CreateTable -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields
[(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Text
fieldName, Text
fieldType) -> Text
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
commaSep
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"} deriving (Eq, Show)\n"
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
typeArguments :: Text
typeArguments :: Text
typeArguments = (?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords
compileInputValueInstance :: CreateTable -> Text
compileInputValueInstance :: CreateTable -> Text
compileInputValueInstance CreateTable
table =
Text
"instance InputValue " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where inputValue = IHP.ModelSupport.recordToInputValue\n"
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName CreateTable
table.name
dataTypeArguments :: (?schema :: Schema) => CreateTable -> [Text]
dataTypeArguments :: (?schema::Schema) => CreateTable -> [Text]
dataTypeArguments CreateTable
table = ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
columnNameToFieldName [Text]
belongsToVariables) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
hasManyVariables
where
belongsToVariables :: [Text]
belongsToVariables = (?schema::Schema) => CreateTable -> [Column]
CreateTable -> [Column]
variableAttributes CreateTable
table [Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name)
hasManyVariables :: [Text]
hasManyVariables =
(?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable CreateTable
table.name
[(Text, Text)]
-> ([(Text, Text)] -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [(Text, Text)] -> [(Text, Text)]
compileQueryBuilderFields
[(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd
dataFields :: (?schema :: Schema) => CreateTable -> [(Text, Text)]
dataFields :: (?schema::Schema) => CreateTable -> [(Text, Text)]
dataFields table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = [(Text, Text)]
columnFields [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
queryBuilderFields [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"meta", Text
"MetaBag")]
where
columnFields :: [(Text, Text)]
columnFields = [Column]
columns [Column] -> ([Column] -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> (Text, Text)) -> [Column] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> (Text, Text)
columnField
columnField :: Column -> (Text, Text)
columnField Column
column =
let fieldName :: Text
fieldName = Text -> Text
columnNameToFieldName Column
column.name
in
( Text
fieldName
, if (?schema::Schema) => CreateTable -> Column -> Bool
CreateTable -> Column -> Bool
isVariableAttribute CreateTable
table Column
column
then Text
fieldName
else (?schema::Schema) => CreateTable -> Column -> Text
CreateTable -> Column -> Text
haskellType CreateTable
table Column
column
)
queryBuilderFields :: [(Text, Text)]
queryBuilderFields = (?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable Text
name [(Text, Text)]
-> ([(Text, Text)] -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [(Text, Text)] -> [(Text, Text)]
compileQueryBuilderFields
compileQueryBuilderFields :: [(Text, Text)] -> [(Text, Text)]
compileQueryBuilderFields :: [(Text, Text)] -> [(Text, Text)]
compileQueryBuilderFields [(Text, Text)]
columns = ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> (Text, Text)
compileQueryBuilderField [(Text, Text)]
columns
where
compileQueryBuilderField :: (Text, Text) -> (Text, Text)
compileQueryBuilderField (Text
refTableName, Text
refColumnName) =
let
hasDuplicateQueryBuilder :: Bool
hasDuplicateQueryBuilder =
[(Text, Text)]
columns
[(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
columnNameToFieldName
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [Text] -> Bool) -> [Text] -> [Text]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Text -> Text
columnNameToFieldName Text
refTableName ==)
[Text] -> ([Text] -> Int) -> Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Int
forall mono. MonoFoldable mono => mono -> Int
length
Int -> (Int -> Bool) -> Bool
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (\Int
count -> Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
stripIdSuffix :: Text -> Text
stripIdSuffix :: Text -> Text
stripIdSuffix Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Text -> Text -> Maybe Text
Text.stripSuffix Text
"_id" Text
name)
fieldName :: Text
fieldName = if Bool
hasDuplicateQueryBuilder
then
(Text
refTableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
refColumnName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
stripIdSuffix))
Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
columnNameToFieldName
Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize
else Text -> Text
columnNameToFieldName Text
refTableName
in
(Text
fieldName, Text
fieldName)
columnsReferencingTable :: (?schema :: Schema) => Text -> [(Text, Text)]
columnsReferencingTable :: (?schema::Schema) => Text -> [(Text, Text)]
columnsReferencingTable Text
theTableName =
let
(Schema [Statement]
statements) = ?schema::Schema
Schema
?schema
in
[Statement]
statements
[Statement] -> ([Statement] -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Statement -> Maybe (Text, Text)) -> [Statement] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe \case
AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, $sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint = ForeignKeyConstraint { Text
columnName :: Text
$sel:columnName:ForeignKeyConstraint :: Constraint -> Text
columnName, Text
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable :: Text
referenceTable, Maybe Text
referenceColumn :: Maybe Text
$sel:referenceColumn:ForeignKeyConstraint :: Constraint -> Maybe Text
referenceColumn } } | Text
referenceTable Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
theTableName -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
tableName, Text
columnName)
Statement
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
variableAttributes :: (?schema :: Schema) => CreateTable -> [Column]
variableAttributes :: (?schema::Schema) => CreateTable -> [Column]
variableAttributes table :: CreateTable
table@(CreateTable { [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = (Element [Column] -> Bool) -> [Column] -> [Column]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter ((?schema::Schema) => CreateTable -> Column -> Bool
CreateTable -> Column -> Bool
isVariableAttribute CreateTable
table) [Column]
columns
isVariableAttribute :: (?schema :: Schema) => CreateTable -> Column -> Bool
isVariableAttribute :: (?schema::Schema) => CreateTable -> Column -> Bool
isVariableAttribute = (?schema::Schema) => CreateTable -> Column -> Bool
CreateTable -> Column -> Bool
isRefCol
isRefCol :: (?schema :: Schema) => CreateTable -> Column -> Bool
isRefCol :: (?schema::Schema) => CreateTable -> Column -> Bool
isRefCol CreateTable
table Column
column = Maybe Constraint -> Bool
forall a. Maybe a -> Bool
isJust ((?schema::Schema) => CreateTable -> Column -> Maybe Constraint
CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint CreateTable
table Column
column)
findForeignKeyConstraint :: (?schema :: Schema) => CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint :: (?schema::Schema) => CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name } Column
column =
case (Element [Statement] -> Bool)
-> [Statement] -> Maybe (Element [Statement])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find Element [Statement] -> Bool
Statement -> Bool
isFkConstraint [Statement]
statements of
Just (AddConstraint { Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint :: Constraint
constraint }) -> Constraint -> Maybe Constraint
forall a. a -> Maybe a
Just Constraint
constraint
Maybe (Element [Statement])
Nothing -> Maybe Constraint
forall a. Maybe a
Nothing
where
isFkConstraint :: Statement -> Bool
isFkConstraint (AddConstraint { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, $sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint = ForeignKeyConstraint { Text
$sel:columnName:ForeignKeyConstraint :: Constraint -> Text
columnName :: Text
columnName }}) = Text
tableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name Bool -> Bool -> Bool
&& Text
columnName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Column
column.name
isFkConstraint Statement
_ = Bool
False
(Schema [Statement]
statements) = ?schema::Schema
Schema
?schema
compileEnumDataDefinitions :: (?schema :: Schema) => Statement -> Text
compileEnumDataDefinitions :: (?schema::Schema) => Statement -> Text
compileEnumDataDefinitions CreateEnumType { $sel:values:StatementCreateTable :: Statement -> [Text]
values = [] } = Text
""
compileEnumDataDefinitions enum :: Statement
enum@(CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name, [Text]
$sel:values:StatementCreateTable :: Statement -> [Text]
values :: [Text]
values }) =
Text
"data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
" | " [Text]
valueConstructors) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" deriving (Eq, Show, Read, Enum, Bounded)\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance FromField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileFromFieldInstanceForValue [Text]
values))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" fromField field (Just value) = returnError ConversionFailed field (\"Unexpected value for enum value. Got: \" <> Data.String.Conversions.cs value)\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" fromField field Nothing = returnError UnexpectedNull field \"Unexpected null for enum value\"\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance Default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where def = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
enumValueToConstructorName ([Text] -> Element [Text]
forall mono. MonoFoldable mono => mono -> Element mono
unsafeHead [Text]
values) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance ToField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileToFieldInstanceForValue [Text]
values))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance InputValue " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileInputValue [Text]
values))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance DeepSeq.NFData " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" rnf a = seq a ()" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance IHP.Controller.Param.ParamReader " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where readParameter = IHP.Controller.Param.enumParamReader; readParameterJSON = IHP.Controller.Param.enumParamReaderJSON\n"
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
valueConstructors :: [Text]
valueConstructors = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
enumValueToConstructorName [Text]
values
enumValueToConstructorName :: Text -> Text
enumValueToConstructorName :: Text -> Text
enumValueToConstructorName Text
enumValue = if Text -> Bool
isEnumValueUniqueInSchema Text
enumValue
then Text -> Text
enumValueToControllerName Text
enumValue
else Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
enumValueToControllerName Text
enumValue)
compileFromFieldInstanceForValue :: Text -> Text
compileFromFieldInstanceForValue Text
value = Text
"fromField field (Just value) | value == (Data.Text.Encoding.encodeUtf8 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = pure " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
enumValueToConstructorName Text
value
compileToFieldInstanceForValue :: Text -> Text
compileToFieldInstanceForValue Text
value = Text
"toField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
enumValueToConstructorName Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = toField (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: Text)"
compileInputValue :: Text -> Text
compileInputValue Text
value = Text
"inputValue " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
enumValueToConstructorName Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: Text"
isEnumValueUniqueInSchema :: Text -> Bool
isEnumValueUniqueInSchema :: Text -> Bool
isEnumValueUniqueInSchema Text
enumValue =
?schema::Schema
Schema
?schema
Schema -> (Schema -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case Schema [Statement]
statements -> [Statement]
statements
[Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [Statement] -> Bool) -> [Statement] -> [Statement]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\case
CreateEnumType { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name, [Text]
$sel:values:StatementCreateTable :: Statement -> [Text]
values :: [Text]
values } | Element [Text]
Text
enumValue Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` [Text]
values -> Bool
True
Element [Statement]
_ -> Bool
False
)
[Statement] -> ([Statement] -> Int) -> Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Statement] -> Int
forall mono. MonoFoldable mono => mono -> Int
length
Int -> (Int -> Bool) -> Bool
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \Int
count -> Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
compileToRowValues :: [Text] -> Text
compileToRowValues :: [Text] -> Text
compileToRowValues [Text]
bindingValues | [Text] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [Text]
bindingValues Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
"Only (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Element [Text]
forall mono. MonoFoldable mono => mono -> Element mono
unsafeHead [Text]
bindingValues) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
compileToRowValues [Text]
bindingValues = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
") :. (" (([Text] -> Text) -> [[Text]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\[Text]
list -> if [Text] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [Text]
list Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"Only (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Element [Text]
forall mono. MonoFoldable mono => mono -> Element mono
unsafeHead [Text]
list) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" else Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " [Text]
list) (Int -> [Text] -> [[Text]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
8 [Text]
bindingValues)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
columnPlaceholder :: Column -> Text
columnPlaceholder :: Column -> Text
columnPlaceholder column :: Column
column@Column { PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType :: PostgresType
columnType } = if Column -> Bool
columnPlaceholderNeedsTypecast Column
column
then Text
"? :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PostgresType -> Text
SqlCompiler.compilePostgresType PostgresType
columnType
else Text
"?"
where
columnPlaceholderNeedsTypecast :: Column -> Bool
columnPlaceholderNeedsTypecast Column { $sel:columnType:Column :: Column -> PostgresType
columnType = PArray {} } = Bool
True
columnPlaceholderNeedsTypecast Column
_ = Bool
False
compileCreate :: CreateTable -> Text
compileCreate :: CreateTable -> Text
compileCreate table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) =
let
writableColumns :: [Column]
writableColumns = [Column] -> [Column]
forall {t2}. (Element t2 ~ Column, IsSequence t2) => t2 -> t2
onlyWritableColumns [Column]
columns
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
columnNames :: Text
columnNames = [Text] -> Text
commaSep ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name) [Column]
writableColumns)
values :: Text
values = [Text] -> Text
commaSep ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
columnPlaceholder [Column]
writableColumns)
toBinding :: Column -> Text
toBinding column :: Column
column@(Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name }) =
if Column -> Bool
hasExplicitOrImplicitDefault Column
column
then Text
"fieldWithDefault #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" model"
else Text
"model." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name
bindings :: [Text]
bindings :: [Text]
bindings = (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
toBinding [Column]
writableColumns
createManyFieldValues :: Text
createManyFieldValues :: Text
createManyFieldValues = if [Text] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null [Text]
bindings
then Text
"()"
else Text
"(List.concat $ List.map (\\model -> [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
b -> Text
"toField (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") [Text]
bindings)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]) models)"
in
Text
"instance CanCreate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent (
Text
"create :: (?modelContext :: ModelContext) => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> IO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"create model = do\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent (Text
"List.head <$> sqlQuery \"INSERT INTO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") VALUES (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
values Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") RETURNING " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
compileToRowValues [Text]
bindings Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n")
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"createMany [] = pure []\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"createMany models = do\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent (Text
"sqlQuery (Query $ \"INSERT INTO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") VALUES \" <> (ByteString.intercalate \", \" (List.map (\\_ -> \"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
values Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\") models)) <> \" RETURNING " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
createManyFieldValues Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
)
)
commaSep :: [Text] -> Text
commaSep :: [Text] -> Text
commaSep = Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", "
toBinding :: Text -> Column -> Text
toBinding :: Text -> Column -> Text
toBinding Text
modelName Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name } = Text
"let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"} = model in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name
onlyWritableColumns :: t2 -> t2
onlyWritableColumns t2
columns = t2
columns t2 -> (t2 -> t2) -> t2
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element t2 -> Bool) -> t2 -> t2
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Column { Maybe ColumnGenerator
$sel:generator:Column :: Column -> Maybe ColumnGenerator
generator :: Maybe ColumnGenerator
generator } -> Maybe ColumnGenerator -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ColumnGenerator
generator)
compileUpdate :: CreateTable -> Text
compileUpdate :: CreateTable -> Text
compileUpdate table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) =
let
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
writableColumns :: [Column]
writableColumns = [Column] -> [Column]
forall {t2}. (Element t2 ~ Column, IsSequence t2) => t2 -> t2
onlyWritableColumns [Column]
columns
toUpdateBinding :: Column -> Text
toUpdateBinding Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name } = Text
"fieldWithUpdate #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" model"
toPrimaryKeyBinding :: Column -> Text
toPrimaryKeyBinding Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name } = Text
"model." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name
bindings :: Text
bindings :: Text
bindings =
let
bindingValues :: [Text]
bindingValues = (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
toUpdateBinding [Column]
writableColumns [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
toPrimaryKeyBinding (CreateTable -> [Column]
primaryKeyColumns CreateTable
table)
in
[Text] -> Text
compileToRowValues [Text]
bindingValues
updates :: Text
updates = [Text] -> Text
commaSep ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Column
column -> Column
column.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column -> Text
columnPlaceholder Column
column ) [Column]
writableColumns)
columnNames :: Text
columnNames = [Column]
writableColumns
[Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", "
in
Text
"instance CanUpdate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent (Text
"updateRecord model = do\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
indent (
Text
"List.head <$> sqlQuery \"UPDATE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" SET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
updates Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE id = ? RETURNING " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bindings Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n"
)
)
compileFromRowInstance :: (?schema :: Schema) => CreateTable -> Text
compileFromRowInstance :: (?schema::Schema) => CreateTable -> Text
compileFromRowInstance table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [i|
instance FromRow #{modelName} where
fromRow = do
#{unsafeInit . indent . indent . unlines $ map columnBinding columnNames}
let theRecord = #{modelName} #{intercalate " " (map compileField (dataFields table))}
pure theRecord
|]
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
columnNames :: [Text]
columnNames = (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text
columnNameToFieldName (Text -> Text) -> (Column -> Text) -> Column -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (.name)) [Column]
columns
columnBinding :: a -> a
columnBinding a
columnName = a
columnName a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" <- field"
referencing :: [(Text, Text)]
referencing = (?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable CreateTable
table.name
compileField :: (Text, Text) -> Text
compileField (Text
fieldName, Text
_)
| Text -> Bool
isColumn Text
fieldName = Text
fieldName
| Text -> Bool
isManyToManyField Text
fieldName = let (Just Element [(Text, Text)]
ref) = (Element [(Text, Text)] -> Bool)
-> [(Text, Text)] -> Maybe (Element [(Text, Text)])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find (\(Text
n, Text
_) -> Text -> Text
columnNameToFieldName Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldName) [(Text, Text)]
referencing in (?schema::Schema) => (Text, Text) -> Text
(Text, Text) -> Text
compileSetQueryBuilder (Text, Text)
Element [(Text, Text)]
ref
| Text
fieldName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"meta" = Text
"def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) }"
| Bool
otherwise = Text
"def"
isPrimaryKey :: Text -> Bool
isPrimaryKey Text
name = Element [Text]
Text
name Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames CreateTable
table.primaryKeyConstraint
isColumn :: Text -> Bool
isColumn Text
name = Element [Text]
Text
name Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` [Text]
columnNames
isManyToManyField :: Text -> Bool
isManyToManyField Text
fieldName = Element [Text]
Text
fieldName Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` ([(Text, Text)]
referencing [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text
columnNameToFieldName (Text -> Text) -> ((Text, Text) -> Text) -> (Text, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst))
compileSetQueryBuilder :: (Text, Text) -> Text
compileSetQueryBuilder (Text
refTableName, Text
refFieldName) = Text
"(QueryBuilder.filterWhere (#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
refFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
primaryKeyField Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") (QueryBuilder.query @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
refTableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"))"
where
primaryKeyField :: Text
primaryKeyField :: Text
primaryKeyField = if Column
refColumn.notNull then Text
"id" else Text
"Just id"
(Just Statement
refTable) = let (Schema [Statement]
statements) = ?schema::Schema
Schema
?schema in
[Statement]
statements
[Statement] -> ([Statement] -> Maybe Statement) -> Maybe Statement
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [Statement] -> Bool)
-> [Statement] -> Maybe (Element [Statement])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find \case
StatementCreateTable CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
refTableName
Element [Statement]
otherwise -> Bool
False
refColumn :: Column
refColumn :: Column
refColumn = Statement
refTable
Statement -> (Statement -> [Column]) -> [Column]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case StatementCreateTable CreateTable { [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns } -> [Column]
columns
[Column] -> ([Column] -> Maybe Column) -> Maybe Column
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [Column] -> Bool) -> [Column] -> Maybe (Element [Column])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find (\Element [Column]
col -> Element [Column]
Column
col.name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
refFieldName)
Maybe Column -> (Maybe Column -> Column) -> Column
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \case
Just Column
refColumn -> Column
refColumn
Maybe Column
Nothing -> [Char] -> Column
forall a. HasCallStack => [Char] -> a
error (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Could not find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Statement
refTable.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
refFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" referenced by a foreign key constraint. Make sure that there is no typo in the foreign key constraint")
compileQuery :: Column -> Text
compileQuery column :: Column
column@(Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name }) = Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Column -> Text
toBinding Text
modelName Column
column Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
compileBuild :: (?schema :: Schema) => CreateTable -> Text
compileBuild :: (?schema::Schema) => CreateTable -> Text
compileBuild table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) =
Text
"instance Record " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {-# INLINE newRecord #-}\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" newRecord = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
toDefaultValueExpr [Column]
columns) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ((?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable Text
name [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> (Text, Text) -> Text
forall a b. a -> b -> a
const Text
"def") [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" def\n"
compileDefaultIdInstance :: CreateTable -> Text
compileDefaultIdInstance :: CreateTable -> Text
compileDefaultIdInstance CreateTable
table = Text
"instance Default (Id' \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CreateTable
table.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\") where def = Id def"
toDefaultValueExpr :: Column -> Text
toDefaultValueExpr :: Column -> Text
toDefaultValueExpr Column { PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType :: PostgresType
columnType, Bool
$sel:notNull:Column :: Column -> Bool
notNull :: Bool
notNull, $sel:defaultValue:Column :: Column -> Maybe Expression
defaultValue = Just Expression
theDefaultValue } =
let
wrapNull :: Bool -> a -> a
wrapNull Bool
False a
value = a
"(Just " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
value a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
wrapNull Bool
True a
value = a
value
isNullExpr :: Expression -> Bool
isNullExpr (VarExpression Text
varName) = Text -> Text
forall t. Textual t => t -> t
toUpper Text
varName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"NULL"
isNullExpr Expression
_ = Bool
False
theNormalizedDefaultValue :: Expression
theNormalizedDefaultValue = Expression
theDefaultValue Expression -> (Expression -> Expression) -> Expression
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Expression -> Expression
SchemaDesigner.removeTypeCasts
in
if Expression -> Bool
isNullExpr Expression
theDefaultValue
then Text
"Nothing"
else
case PostgresType
columnType of
PostgresType
PText -> case Expression
theNormalizedDefaultValue of
TextExpression Text
value -> Bool -> Text -> Text
forall {a}. (Semigroup a, IsString a) => Bool -> a -> a
wrapNull Bool
notNull (Text -> Text
forall a. Show a => a -> Text
tshow Text
value)
Expression
otherwise -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"toDefaultValueExpr: TEXT column needs to have a TextExpression as default value. Got: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expression -> [Char]
forall a. Show a => a -> [Char]
show Expression
otherwise)
PostgresType
PBoolean -> case Expression
theNormalizedDefaultValue of
VarExpression Text
value -> Bool -> Text -> Text
forall {a}. (Semigroup a, IsString a) => Bool -> a -> a
wrapNull Bool
notNull (Bool -> Text
forall a. Show a => a -> Text
tshow (Text -> Text
forall t. Textual t => t -> t
toLower Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"))
Expression
otherwise -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"toDefaultValueExpr: BOOL column needs to have a VarExpression as default value. Got: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expression -> [Char]
forall a. Show a => a -> [Char]
show Expression
otherwise)
PostgresType
PDouble -> case Expression
theNormalizedDefaultValue of
DoubleExpression Double
value -> Bool -> Text -> Text
forall {a}. (Semigroup a, IsString a) => Bool -> a -> a
wrapNull Bool
notNull (Double -> Text
forall a. Show a => a -> Text
tshow Double
value)
IntExpression Int
value -> Bool -> Text -> Text
forall {a}. (Semigroup a, IsString a) => Bool -> a -> a
wrapNull Bool
notNull (Int -> Text
forall a. Show a => a -> Text
tshow Int
value)
Expression
otherwise -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"toDefaultValueExpr: DOUBLE column needs to have a DoubleExpression as default value. Got: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expression -> [Char]
forall a. Show a => a -> [Char]
show Expression
otherwise)
PostgresType
_ -> Text
"def"
toDefaultValueExpr Column
_ = Text
"def"
compileHasTableNameInstance :: (?schema :: Schema) => CreateTable -> Text
compileHasTableNameInstance :: (?schema::Schema) => CreateTable -> Text
compileHasTableNameInstance table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) =
Text
"type instance GetTableName (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text -> Text
forall a b. a -> b -> a
const Text
"_") ((?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"type instance GetModelByTableName " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
compilePrimaryKeyInstance :: (?schema :: Schema) => CreateTable -> Text
compilePrimaryKeyInstance :: (?schema::Schema) => CreateTable -> Text
compilePrimaryKeyInstance table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns, [Constraint]
constraints :: [Constraint]
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
constraints }) = [trimming|
type instance PrimaryKey $symbol = $idType
|]
where
symbol :: Text
symbol = Text -> Text
forall a. Show a => a -> Text
tshow Text
name
idType :: Text
idType :: Text
idType = case CreateTable -> [Column]
primaryKeyColumns CreateTable
table of
[] -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
". At least one primary key is required."
[Column
column] -> PostgresType -> Text
atomicType Column
column.columnType
[Column]
cs -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
colType [Column]
cs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
where
colType :: Column -> Text
colType Column
column = (?schema::Schema) => CreateTable -> Column -> Text
CreateTable -> Column -> Text
haskellType CreateTable
table Column
column
compileFilterPrimaryKeyInstance :: (?schema :: Schema) => CreateTable -> Text
compileFilterPrimaryKeyInstance :: (?schema::Schema) => CreateTable -> Text
compileFilterPrimaryKeyInstance table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns, [Constraint]
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
constraints :: [Constraint]
constraints }) = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [i|
instance QueryBuilder.FilterPrimaryKey "#{name}" where
filterWhereId #{primaryKeyPattern} builder =
builder |> #{intercalate " |> " primaryKeyFilters}
{-# INLINE filterWhereId #-}
|]
where
primaryKeyPattern :: Text
primaryKeyPattern = case CreateTable -> [Column]
primaryKeyColumns CreateTable
table of
[] -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
". At least one primary key is required."
[Column
c] -> Column
c.name
[Column]
cs -> Text
"(Id (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text
columnNameToFieldName (Text -> Text) -> (Column -> Text) -> Column -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (.name)) [Column]
cs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"))"
primaryKeyFilters :: [Text]
primaryKeyFilters :: [Text]
primaryKeyFilters = (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
primaryKeyFilter ([Column] -> [Text]) -> [Column] -> [Text]
forall a b. (a -> b) -> a -> b
$ CreateTable -> [Column]
primaryKeyColumns CreateTable
table
primaryKeyFilter :: Column -> Text
primaryKeyFilter :: Column -> Text
primaryKeyFilter Column {Text
$sel:name:Column :: Column -> Text
name :: Text
name} = Text
"QueryBuilder.filterWhere (#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
compileTableInstance :: (?schema :: Schema) => CreateTable -> Text
compileTableInstance :: (?schema::Schema) => CreateTable -> Text
compileTableInstance table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns, [Constraint]
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
constraints :: [Constraint]
constraints }) = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [i|
instance #{instanceHead} where
tableName = \"#{name}\"
tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\"
columnNames = #{columnNames}
primaryKeyCondition #{pattern} = #{condition}
{-# INLINABLE primaryKeyCondition #-}
|]
where
instanceHead :: Text
instanceHead :: Text
instanceHead = Text
instanceConstraints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => Table (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
where
instanceConstraints :: Text
instanceConstraints =
CreateTable
table
CreateTable -> (CreateTable -> [Column]) -> [Column]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> CreateTable -> [Column]
primaryKeyColumns
[Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name)
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
columnNameToFieldName
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Element [Text] -> Bool) -> [Text] -> [Text]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (\Element [Text]
field -> Element [Text]
field Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` ((?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table))
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
field -> Text
"ToField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", "
Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \Text
inner -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
primaryKeyColumnNames :: [Text]
primaryKeyColumnNames :: [Text]
primaryKeyColumnNames = (CreateTable -> [Column]
primaryKeyColumns CreateTable
table) [Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name)
primaryKeyFieldNames :: [Text]
primaryKeyFieldNames :: [Text]
primaryKeyFieldNames = [Text]
primaryKeyColumnNames [Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
columnNameToFieldName
pattern :: Text
pattern :: Text
pattern = Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", " [Text]
primaryKeyFieldNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" }"
condition :: Text
condition :: Text
condition = CreateTable -> [Column]
primaryKeyColumns CreateTable
table
[Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
primaryKeyToCondition
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
Text
", "
Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> \Text
listInner -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
listInner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
primaryKeyToCondition :: Column -> Text
primaryKeyToCondition :: Column -> Text
primaryKeyToCondition Column
column = Text
"(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column
column.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", toField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Column
column.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
columnNames :: Text
columnNames = [Column]
columns
[Column] -> ([Column] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name)
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
forall a. Show a => a -> Text
tshow
compileGetModelName :: (?schema :: Schema) => CreateTable -> Text
compileGetModelName :: (?schema::Schema) => CreateTable -> Text
compileGetModelName table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) = Text
"type instance GetModelName (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> Text -> Text
forall a b. a -> b -> a
const Text
"_") ((?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow (Text -> Text
tableNameToModelName Text
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
compileDataTypePattern :: (?schema :: Schema) => CreateTable -> Text
compileDataTypePattern :: (?schema::Schema) => CreateTable -> Text
compileDataTypePattern table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) = Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords (CreateTable
table CreateTable -> (CreateTable -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst)
compileTypePattern :: (?schema :: Schema) => CreateTable -> Text
compileTypePattern :: (?schema::Schema) => CreateTable -> Text
compileTypePattern table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) = Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table)
compileInclude :: (?schema :: Schema) => CreateTable -> Text
compileInclude :: (?schema::Schema) => CreateTable -> Text
compileInclude table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = ([Text]
belongsToIncludes [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
hasManyIncludes) [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines
where
belongsToIncludes :: [Text]
belongsToIncludes = (Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Column -> Text
compileBelongsTo ((Element [Column] -> Bool) -> [Column] -> [Column]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter ((?schema::Schema) => CreateTable -> Column -> Bool
CreateTable -> Column -> Bool
isRefCol CreateTable
table) [Column]
columns)
hasManyIncludes :: [Text]
hasManyIncludes = (?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable Text
name
[(Text, Text)]
-> ([(Text, Text)] -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (\[(Text, Text)]
refs -> [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Text)]
refs) (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst ([(Text, Text)] -> [(Text, Text)]
compileQueryBuilderFields [(Text, Text)]
refs)))
[(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
compileHasMany
typeArgs :: [Text]
typeArgs = (?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
modelConstructor :: Text
modelConstructor = Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
includeType :: Text -> Text -> Text
includeType :: Text -> Text -> Text
includeType Text
fieldName Text
includedType = Text
"type instance Include " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
leftModelType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rightModelType
where
leftModelType :: Text
leftModelType = [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords (Text
modelConstructorText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
typeArgs)
rightModelType :: Text
rightModelType = [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords (Text
modelConstructorText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileTypeVariable' [Text]
typeArgs))
compileTypeVariable' :: Text -> Text
compileTypeVariable' Text
name | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldName = Text
includedType
compileTypeVariable' Text
name = Text
name
compileBelongsTo :: Column -> Text
compileBelongsTo :: Column -> Text
compileBelongsTo Column
column = Text -> Text -> Text
includeType (Text -> Text
columnNameToFieldName Column
column.name) (Text
"(GetModelById " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName Column
column.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
compileHasMany :: (Text, Text) -> Text
compileHasMany :: (Text, Text) -> Text
compileHasMany (Text
refTableName, Text
refColumnName) = Text -> Text -> Text
includeType Text
refColumnName (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
refTableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
compileSetFieldInstances :: (?schema :: Schema) => CreateTable -> Text
compileSetFieldInstances :: (?schema::Schema) => CreateTable -> Text
compileSetFieldInstances table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
compileSetField ((?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields CreateTable
table))
where
setMetaField :: Text
setMetaField = Text
"instance SetField \"meta\" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") MetaBag where\n {-# INLINE setField #-}\n setField newValue (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileDataTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tableNameToModelName Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Column -> Text) -> [Column] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (.name) [Column]
columns)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" newValue"
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
typeArgs :: [Text]
typeArgs = (?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table
compileSetField :: (Text, Text) -> Text
compileSetField (Text
name, Text
fieldType) =
Text
"instance SetField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" {-# INLINE setField #-}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" setField newValue (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileDataTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") =\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileAttribute (CreateTable
table CreateTable -> (CreateTable -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst)))
where
compileAttribute :: Text -> Text
compileAttribute Text
name'
| Text
name' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name = Text
"newValue"
| Text
name' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"meta" = Text
"(meta { touchedFields = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" : touchedFields meta })"
| Bool
otherwise = Text
name'
compileUpdateFieldInstances :: (?schema :: Schema) => CreateTable -> Text
compileUpdateFieldInstances :: (?schema::Schema) => CreateTable -> Text
compileUpdateFieldInstances table :: CreateTable
table@(CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns }) = [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
compileSetField ((?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields CreateTable
table))
where
modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name
typeArgs :: [Text]
typeArgs = (?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table
compileSetField :: (Text, Text) -> Text
compileSetField (Text
name, Text
fieldType) = Text
"instance UpdateField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
compileTypePattern' Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valueTypeA Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valueTypeB Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n {-# INLINE updateField #-}\n updateField newValue (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileDataTypePattern CreateTable
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
compileAttribute (CreateTable
table CreateTable -> (CreateTable -> [(Text, Text)]) -> [(Text, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (?schema::Schema) => CreateTable -> [(Text, Text)]
CreateTable -> [(Text, Text)]
dataFields [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst)))
where
(Text
valueTypeA, Text
valueTypeB) =
if Element [Text]
Text
name Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` [Text]
typeArgs
then (Text
name, Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
else (Text
fieldType, Text
fieldType)
compileAttribute :: Text -> Text
compileAttribute Text
name'
| Text
name' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name = Text
"newValue"
| Text
name' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"meta" = Text
"(meta { touchedFields = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" : touchedFields meta })"
| Bool
otherwise = Text
name'
compileTypePattern' :: Text -> Text
compileTypePattern' :: Text -> Text
compileTypePattern' Text
name = Text -> Text
tableNameToModelName CreateTable
table.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
f -> if Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name then Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" else Text
f) ((?schema::Schema) => CreateTable -> [Text]
CreateTable -> [Text]
dataTypeArguments CreateTable
table))
compileHasFieldId :: (?schema :: Schema) => CreateTable -> Text
compileHasFieldId :: (?schema::Schema) => CreateTable -> Text
compileHasFieldId table :: CreateTable
table@CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint } = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [i|
instance HasField "id" #{tableNameToModelName name} (Id' "#{name}") where
getField (#{compileDataTypePattern table}) = #{compilePrimaryKeyValue}
{-# INLINE getField #-}
|]
where
compilePrimaryKeyValue :: Text
compilePrimaryKeyValue = case PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint of
[Text
id] -> Text -> Text
columnNameToFieldName Text
id
[Text]
ids -> Text
"Id (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
commaSep ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
columnNameToFieldName [Text]
ids) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
needsHasFieldId :: CreateTable -> Bool
needsHasFieldId :: CreateTable -> Bool
needsHasFieldId CreateTable { PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint } =
case PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint of
[] -> Bool
False
[Text
"id"] -> Bool
False
[Text]
_ -> Bool
True
primaryKeyColumns :: CreateTable -> [Column]
primaryKeyColumns :: CreateTable -> [Column]
primaryKeyColumns CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [Column]
columns, PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint } =
(Text -> Column) -> [Text] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Element [Column]
Text -> Column
getColumn (PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint)
where
getColumn :: Text -> Element [Column]
getColumn Text
columnName = case (Element [Column] -> Bool) -> [Column] -> Maybe (Element [Column])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
columnName (Text -> Bool) -> (Column -> Text) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (.name)) [Column]
columns of
Just Element [Column]
c -> Element [Column]
c
Maybe (Element [Column])
Nothing -> [Char] -> Column
forall a. HasCallStack => [Char] -> a
error ([Char]
"Missing column " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
columnName [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" used in primary key for " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
indent :: Text -> Text
indent :: Text -> Text
indent Text
code = Text
code
Text -> (Text -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text]
Text.lines
[Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
forall {a}. (Eq a, IsString a, Semigroup a) => a -> a
indentLine
[Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
Text.unlines
where
indentLine :: a -> a
indentLine a
"" = a
""
indentLine a
line = a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
line
hasExplicitOrImplicitDefault :: Column -> Bool
hasExplicitOrImplicitDefault :: Column -> Bool
hasExplicitOrImplicitDefault Column
column = case Column
column of
Column { $sel:defaultValue:Column :: Column -> Maybe Expression
defaultValue = Just Expression
_ } -> Bool
True
Column { $sel:columnType:Column :: Column -> PostgresType
columnType = PostgresType
PSerial } -> Bool
True
Column { $sel:columnType:Column :: Column -> PostgresType
columnType = PostgresType
PBigserial } -> Bool
True
Column
_ -> Bool
False