module IHP.SchemaCompiler
( compile
, compileStatementPreview
) where

import ClassyPrelude
import Data.String.Conversions (cs)
import Data.String.Interpolate (i)
import IHP.NameSupport (tableNameToModelName, columnNameToFieldName, enumValueToControllerName)
import Data.Maybe (fromJust)
import qualified Data.Text as Text
import qualified System.Directory as Directory
import Data.List ((!!), (\\))
import Data.List.Split
import IHP.HaskellSupport
import qualified Text.Countable as Countable
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner
import IHP.IDE.SchemaDesigner.Types
import Control.Monad.Fail
import qualified IHP.IDE.SchemaDesigner.Compiler as SqlCompiler

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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
parserError -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
parserError)
        Right [Statement]
statements -> do
            -- let validationErrors = validate database
            -- unless (null validationErrors) (error $ "Schema.hs contains errors: " <> cs (unsafeHead validationErrors))
            Bool -> String -> IO ()
Directory.createDirectoryIfMissing Bool
True String
"build/Generated"
            String -> Text -> IO ()
writeIfDifferent String
typesFilePath (CompilerOptions -> Schema -> Text
compileTypes CompilerOptions
options ([Statement] -> Schema
Schema [Statement]
statements))

typesFilePath :: FilePath
typesFilePath :: String
typesFilePath = String
"build/Generated/Types.hs"

singularize :: Text -> Text
singularize Text
word = Text -> Text
Countable.singularize Text
word

newtype Schema = Schema [Statement]

data CompilerOptions = CompilerOptions {
        -- | We can toggle the generation of @SetField@ and @GetField@ instances.
        -- This is e.g. disabled when showing the code preview in the schema designer
        -- as it's very noisy and does not add any values. But of course it's needed
        -- when do a compilation for the Types.hs
        CompilerOptions -> Bool
compileGetAndSetFieldInstances :: Bool
    }

fullCompileOptions :: CompilerOptions
fullCompileOptions :: CompilerOptions
fullCompileOptions = CompilerOptions :: Bool -> CompilerOptions
CompilerOptions { $sel:compileGetAndSetFieldInstances:CompilerOptions :: Bool
compileGetAndSetFieldInstances = Bool
True }

previewCompilerOptions :: CompilerOptions
previewCompilerOptions :: CompilerOptions
previewCompilerOptions = CompilerOptions :: Bool -> CompilerOptions
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"
    PCustomType Text
theType -> Text -> Text
tableNameToModelName Text
theType
    PostgresType
PTimestamp -> Text
"LocalTime"
    (PNumeric Maybe Int
_ Maybe Int
_) -> Text
"Float"
    (PVaryingN 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
PInet -> Text
"Net.IP.IP"

haskellType :: (?schema :: Schema) => CreateTable -> Column -> Text
haskellType :: CreateTable -> Column -> Text
haskellType table :: CreateTable
table@CreateTable { $sel:name:CreateTable :: CreateTable -> Text
name = Text
tableName, PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint } column :: Column
column@Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name, PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType :: PostgresType
columnType, Bool
$sel:notNull:Column :: Column -> Bool
notNull :: Bool
notNull }
    | [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
")"
    | Element [Text]
Text
name Element [Text] -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint = PostgresType -> Text
atomicType PostgresType
columnType
    | 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
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable :: 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
                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
-- haskellType table (HasMany {name}) = "(QueryBuilder.QueryBuilder " <> tableNameToModelName name <> ")"


writeIfDifferent :: FilePath -> Text -> IO ()
writeIfDifferent :: String -> Text -> IO ()
writeIfDifferent String
path Text
content = do
    Bool
alreadyExists <- String -> IO Bool
Directory.doesFileExist String
path
    ByteString
existingContent <- if Bool
alreadyExists then String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFile String
path else ByteString -> IO ByteString
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
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
path
        String -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => String -> ByteString -> m ()
writeFile (String -> String
forall a b. ConvertibleStrings a b => a -> b
cs String
path) (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
content)



section :: Text
section = Text
"\n"

compileTypes :: CompilerOptions -> Schema -> Text
compileTypes :: CompilerOptions -> Schema -> Text
compileTypes CompilerOptions
options schema :: Schema
schema@(Schema [Statement]
statements) =
        Text
prelude
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> let ?schema = schema
            in Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
"\n\n" ((Statement -> Text) -> [Statement] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((?schema::Schema) => CompilerOptions -> Statement -> Text
CompilerOptions -> Statement -> Text
compileStatement CompilerOptions
options) [Statement]
statements)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section
    where
        prelude :: Text
prelude = Text
"-- This file is auto generated and will be overriden regulary. Please edit `Application/Schema.sql` to change the Types\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, TypeFamilies, DataKinds, TypeOperators, UndecidableInstances, ConstraintKinds, StandaloneDeriving  #-}\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{-# OPTIONS_GHC -Wno-unused-imports -Wno-dodgy-imports -Wno-unused-matches #-}\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"module Generated.Types where\n\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import IHP.HaskellSupport\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import IHP.ModelSupport\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import CorePrelude hiding (id)\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Data.Time.Clock\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Data.Time.LocalTime\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.Time.Calendar\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.List as List\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.ByteString as ByteString \n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Net.IP \n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Database.PostgreSQL.Simple\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Database.PostgreSQL.Simple.FromRow\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Database.PostgreSQL.Simple.FromField hiding (Field, name)\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Database.PostgreSQL.Simple.ToField hiding (Field)\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified IHP.Controller.Param\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import GHC.TypeLits\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Data.UUID (UUID)\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Data.Default\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified IHP.QueryBuilder as QueryBuilder\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.Proxy\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import GHC.Records\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Data.Data\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.String.Conversions\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.Text.Encoding\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.Aeson\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import Database.PostgreSQL.Simple.Types (Query (Query), Binary ( .. ))\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Database.PostgreSQL.Simple.Types\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import IHP.Job.Types\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import IHP.Job.Queue ()\n"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"import qualified Data.Dynamic\n"

compileStatementPreview :: [Statement] -> Statement -> Text
compileStatementPreview :: [Statement] -> Statement -> Text
compileStatementPreview [Statement]
statements Statement
statement = let ?schema = Schema statements in (?schema::Schema) => CompilerOptions -> Statement -> Text
CompilerOptions -> Statement -> Text
compileStatement CompilerOptions
previewCompilerOptions Statement
statement

compileStatement :: (?schema :: Schema) => CompilerOptions -> Statement -> Text
compileStatement :: CompilerOptions -> Statement -> Text
compileStatement CompilerOptions { Bool
compileGetAndSetFieldInstances :: Bool
$sel:compileGetAndSetFieldInstances:CompilerOptions :: CompilerOptions -> Bool
compileGetAndSetFieldInstances } (StatementCreateTable CreateTable
table) =
    case CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint CreateTable
table of
        -- Skip generation of tables with no primary keys
        PrimaryKeyConstraint [] -> Text
""
        PrimaryKeyConstraint
_ -> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileData CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileTypeAlias CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileFromRowInstance CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileHasTableNameInstance CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileGetModelName CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compilePrimaryKeyInstance CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileInclude CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CreateTable -> Text
compileCreate CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CreateTable -> Text
compileUpdate CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileBuild CreateTable
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if CreateTable -> Bool
needsHasFieldId CreateTable
table
                    then (?schema::Schema) => CreateTable -> Text
CreateTable -> Text
compileHasFieldId CreateTable
table
                    else Text
""
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
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
""
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
section

compileStatement CompilerOptions
_ enum :: Statement
enum@(CreateEnumType {}) = Statement -> Text
compileEnumDataDefinitions Statement
enum
compileStatement CompilerOptions
_ Statement
_ = Text
""

compileTypeAlias :: (?schema :: Schema) => CreateTable -> Text
compileTypeAlias :: CreateTable -> Text
compileTypeAlias table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns :: [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 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 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 :: CreateTable -> Text
compileData table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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"
        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 inputValue = IHP.ModelSupport.recordToInputValue\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 t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords

-- | Returns all the type arguments of the data structure for an entity
dataTypeArguments :: (?schema :: Schema) => CreateTable -> [Text]
dataTypeArguments :: 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 (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name)
        hasManyVariables :: [Text]
hasManyVariables =
            (?schema::Schema) => Text -> [(Text, Text)]
Text -> [(Text, Text)]
columnsReferencingTable (Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table)
            [(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

-- | Returns the field names and types for the @data MyRecord = MyRecord { .. }@ for a given table
dataFields :: (?schema :: Schema) => CreateTable -> [(Text, Text)]
dataFields :: CreateTable -> [(Text, Text)]
dataFields table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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 (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column)
            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
                -- Given a relationship like the following:
                --
                -- CREATE TABLE referrals (
                --     user_id UUID NOT NULL,
                --     referred_user_id UUID DEFAULT uuid_generate_v4() NOT NULL
                -- );
                --
                -- We would have two fields on the @User@ record called @referrals@ which are
                -- going to be used with fetchRelated (user >>= fetchRelated #referrals).
                --
                -- Of course having two fields in the same record does not work, so we have to
                -- detect these duplicate query builder fields and use a more qualified name.
                --
                -- In the example this will lead to two fileds called @referralsUsers@ and @referralsReferredUsers@
                -- being added to the data structure.
                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 -> Bool
forall a. Eq a => a -> a -> Bool
==)
                    [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
Countable.pluralize
                    else Text -> Text
columnNameToFieldName Text
refTableName
            in
                (Text
fieldName, Text
fieldName)


-- | Finds all the columns referencing a specific table via a foreign key constraint
--
-- __Example:__
--
-- Given the schema:
--
-- > CREATE TABLE users (id SERIAL, company_id INT);
-- > CREATE TABLE companies (id SERIAL);
--
-- you can do the following:
--
-- >>> columnsReferencingTable "companies"
-- [ ("users", "company_id") ]
columnsReferencingTable :: (?schema :: Schema) => Text -> [(Text, Text)]
columnsReferencingTable :: 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
$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
referenceTable :: Text
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable, Maybe Text
$sel:referenceColumn:ForeignKeyConstraint :: Constraint -> Maybe Text
referenceColumn :: 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 :: CreateTable -> [Column]
variableAttributes table :: CreateTable
table@(CreateTable { [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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 :: CreateTable -> Column -> Bool
isVariableAttribute = (?schema::Schema) => CreateTable -> Column -> Bool
CreateTable -> Column -> Bool
isRefCol


-- | Returns @True@ when the coluns is referencing another column via foreign key constraint
isRefCol :: (?schema :: Schema) => CreateTable -> Column -> Bool
isRefCol :: 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)

-- | Returns the foreign key constraint bound on the given column
findForeignKeyConstraint :: (?schema :: Schema) => CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint :: CreateTable -> Column -> Maybe Constraint
findForeignKeyConstraint CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> 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 }) -> 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
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
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
== Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column
        isFkConstraint Statement
_ = Bool
False

        (Schema [Statement]
statements) = ?schema::Schema
Schema
?schema

compileEnumDataDefinitions :: Statement -> Text
compileEnumDataDefinitions :: Statement -> Text
compileEnumDataDefinitions CreateEnumType { $sel:name:StatementCreateTable :: Statement -> Text
name = Text
""} = Text
"" -- Ignore enums without any values
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]
valueConstructors) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" deriving (Eq, Show, Read, Enum)\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 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
enumValueToControllerName ([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 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 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
"\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\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
enumValueToControllerName [Text]
values
        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
enumValueToControllerName Text
value
        compileToFieldInstanceForValue :: Text -> Text
compileToFieldInstanceForValue Text
value = Text
"toField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
enumValueToControllerName 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
enumValueToControllerName 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"

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]
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]
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
")"


compileCreate :: CreateTable -> Text
compileCreate :: CreateTable -> Text
compileCreate table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) =
    let
        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 (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name) [Column]
columns)
        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]
columns)

        -- When we do an INSERT query like @INSERT INTO values (uuids) VALUES (?)@ where the type of @uuids@ is @UUID[]@
        -- we need to add a typecast to the placeholder @?@, otherwise this will throw an sql error
        -- See https://github.com/digitallyinduced/ihp/issues/593
        columnPlaceholder :: Column -> Text
columnPlaceholder column :: Column
column@(Column { PostgresType
columnType :: PostgresType
$sel:columnType:Column :: Column -> 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

        toBinding :: Column -> Text
toBinding column :: Column
column@(Column { Text
name :: Text
$sel:name:Column :: Column -> 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
"get #" 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"


        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]
columns

        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]
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] -> 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
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]
", "

toBinding :: Text -> Column -> Text
toBinding :: Text -> Column -> Text
toBinding Text
modelName Column { Text
name :: Text
$sel:name:Column :: Column -> 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

compileUpdate :: CreateTable -> Text
compileUpdate :: CreateTable -> Text
compileUpdate table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) =
    let
        modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
name

        toUpdateBinding :: Column -> Text
toUpdateBinding Column { Text
name :: Text
$sel:name:Column :: Column -> 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
name :: Text
$sel:name:Column :: Column -> Text
name } = Text
"get #" 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"

        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]
columns [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 -> Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?") [Column]
columns)
    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
bindings Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n"
                )
            )

compileFromRowInstance :: (?schema :: Schema) => CreateTable -> Text
compileFromRowInstance :: CreateTable -> Text
compileFromRowInstance table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) = String -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#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 (Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table)

        compileField :: (Text, Text) -> Text
compileField (Text
fieldName, Text
_)
            | Text -> Bool
isColumn Text
fieldName = Text
fieldName
            | Text -> Bool
isManyToManyField Text
fieldName = let (Just (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 (\(n, _) -> 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)
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 -> PrimaryKeyConstraint
primaryKeyConstraint CreateTable
table)
        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 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
                -- | When the referenced column is nullable, we have to wrap the @Id@ in @Just@
                primaryKeyField :: Text
                primaryKeyField :: Text
primaryKeyField = if Proxy "notNull" -> Column -> Bool
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "notNull" (Proxy "notNull")
Proxy "notNull"
#notNull Column
refColumn 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 { 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]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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 -> Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Element [Column]
Column
col 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 -> String -> Column
forall a. HasCallStack => String -> a
error (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Could not find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy "name" -> Statement -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Statement
refTable 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
name :: Text
$sel:name:Column :: Column -> 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
")"
        -- compileQuery column@(Column { name }) | isReferenceColum column = columnNameToFieldName name <> " = (" <> toBinding modelName column <> ")"
        --compileQuery (HasMany hasManyName inverseOf) = columnNameToFieldName hasManyName <> " = (QueryBuilder.filterWhere (Data.Proxy.Proxy @" <> tshow relatedFieldName <> ", " <> (fromJust $ toBinding' (tableNameToModelName name) relatedIdField)  <> ") (QueryBuilder.query @" <> tableNameToModelName hasManyName <>"))"
        --    where
        --        compileInverseOf Nothing = (columnNameToFieldName (singularize name)) <> "Id"
        --        compileInverseOf (Just name) = columnNameToFieldName (singularize name)
        --        relatedFieldName = compileInverseOf inverseOf
        --        relatedIdField = relatedField "id"
        --        relatedForeignKeyField = relatedField relatedFieldName
        --        relatedField :: Text -> Attribute
        --        relatedField relatedFieldName =
        --            let
        --                isFieldName name (Field fieldName _) = (columnNameToFieldName fieldName) == name
        --                (Table _ attributes) = relatedTable
        --            in case find (isFieldName relatedFieldName) (fieldsOnly attributes) of
        --                Just a -> a
        --                Nothing ->
        --                    let (Table tableName _) = relatedTable
        --                    in error (
        --                            "Could not find field "
        --                            <> show relatedFieldName
        --                            <> " in table"
        --                            <> cs tableName
        --                            <> " "
        --                            <> (show $ fieldsOnly attributes)
        --                            <> ".\n\nThis is caused by `+ hasMany " <> show hasManyName <> "`"
        --                        )
        --        relatedTable = case find (\(Table tableName _) -> tableName == hasManyName) database of
        --            Just t -> t
        --            Nothing -> error ("Could not find table " <> show hasManyName)
        --        toBinding' modelName attributes =
        --            case relatedForeignKeyField of
        --                Field _ fieldType | allowNull fieldType -> Just $ "Just (" <> fromJust (toBinding modelName attributes) <> ")"
        --                otherwise -> toBinding modelName attributes

compileBuild :: (?schema :: Schema) => CreateTable -> Text
compileBuild :: CreateTable -> Text
compileBuild table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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 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 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"


toDefaultValueExpr :: Column -> Text
toDefaultValueExpr :: Column -> Text
toDefaultValueExpr Column { PostgresType
columnType :: PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType, Bool
notNull :: Bool
$sel:notNull:Column :: Column -> Bool
notNull, $sel:defaultValue:Column :: Column -> Maybe Expression
defaultValue = Just Expression
theDefaultValue } =
            let
                wrapNull :: Bool -> p -> p
wrapNull Bool
False p
value = p
"(Just " p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
value p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
")"
                wrapNull Bool
True p
value = p
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
            in
                if Expression -> Bool
isNullExpr Expression
theDefaultValue
                    then Text
"Nothing"
                    else
                        case PostgresType
columnType of
                            PostgresType
PText -> case Expression
theDefaultValue of
                                TextExpression Text
value -> Bool -> Text -> Text
forall p. (Semigroup p, IsString p) => Bool -> p -> p
wrapNull Bool
notNull (Text -> Text
forall a. Show a => a -> Text
tshow Text
value)
                                Expression
otherwise            -> String -> Text
forall a. HasCallStack => String -> a
error (String
"toDefaultValueExpr: TEXT column needs to have a TextExpression as default value. Got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Expression -> String
forall a. Show a => a -> String
show Expression
otherwise)
                            PostgresType
PBoolean -> case Expression
theDefaultValue of
                                VarExpression Text
value -> Bool -> Text -> Text
forall p. (Semigroup p, IsString p) => Bool -> p -> p
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           -> String -> Text
forall a. HasCallStack => String -> a
error (String
"toDefaultValueExpr: BOOL column needs to have a VarExpression as default value. Got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Expression -> String
forall a. Show a => a -> String
show Expression
otherwise)
                            PostgresType
_ -> Text
"def"
toDefaultValueExpr Column
_ = Text
"def"

compileHasTableNameInstance :: (?schema :: Schema) => CreateTable -> Text
compileHasTableNameInstance :: CreateTable -> Text
compileHasTableNameInstance table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> 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 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 :: CreateTable -> Text
compilePrimaryKeyInstance table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns, [Constraint]
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
constraints :: [Constraint]
constraints }) = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [i|
type instance PrimaryKey #{tshow name} = #{idType}

instance QueryBuilder.FilterPrimaryKey "#{name}" where
    filterWhereId #{primaryKeyPattern} builder =
        builder |> #{intercalate " |> " primaryKeyFilters}
    {-# INLINE filterWhereId #-}
|]
    where
        idType :: Text
        idType :: Text
idType = case CreateTable -> [Column]
primaryKeyColumns CreateTable
table of
            [] -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". At least one primary key is required."
            [Column
c] -> Column -> Text
colType Column
c
            [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]
", " ((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 = PostgresType -> Text
atomicType (PostgresType -> Text)
-> (Column -> PostgresType) -> Column -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy "columnType" -> Column -> PostgresType
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "columnType" (Proxy "columnType")
Proxy "columnType"
#columnType

        primaryKeyPattern :: Text
primaryKeyPattern = case CreateTable -> [Column]
primaryKeyColumns CreateTable
table of
            [] -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". At least one primary key is required."
            [Column
c] -> Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
c
            [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]
", " ((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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#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
name :: Text
$sel:name:Column :: Column -> 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
")"

compileGetModelName :: (?schema :: Schema) => CreateTable -> Text
compileGetModelName :: CreateTable -> Text
compileGetModelName table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> 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 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 :: CreateTable -> Text
compileDataTypePattern table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> 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 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 :: CreateTable -> Text
compileTypePattern table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> 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 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 :: CreateTable -> Text
compileInclude table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [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 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]
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            where
                leftModelType :: Text
leftModelType = [Text] -> 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 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 (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column)) (Text
"(GetModelById " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
columnNameToFieldName (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column) 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 -> Text
columnNameToFieldName Text
refTableName) (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 :: CreateTable -> Text
compileSetFieldInstances table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) = [Text] -> 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 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 (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#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 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 :: CreateTable -> Text
compileUpdateFieldInstances table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns }) = [Text] -> 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 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 (Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name 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 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 :: CreateTable -> Text
compileHasFieldId table :: CreateTable
table@CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint } = String -> 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
primaryKeyConstraint :: PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> 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
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name, [Column]
columns :: [Column]
$sel:columns:CreateTable :: CreateTable -> [Column]
columns, PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint } =
    (Text -> Column) -> [Text] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Column
getColumn (PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames PrimaryKeyConstraint
primaryKeyConstraint)
  where
    getColumn :: Text -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name) [Column]
columns of
      Just Element [Column]
c -> Element [Column]
Column
c
      Maybe (Element [Column])
Nothing -> String -> Column
forall a. HasCallStack => String -> a
error (String
"Missing column " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
columnName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" used in primary key for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
name)

-- | Indents a block of code with 4 spaces.
--
-- Empty lines are not indented.
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 p. (Eq p, IsString p, Semigroup p) => p -> p
indentLine
        [Text] -> ([Text] -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
Text.unlines
    where
        indentLine :: p -> p
indentLine p
""   = p
""
        indentLine p
line = p
"    " p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
line

-- | Returns 'True' when the column has an explicit default value or when it's a SERIAL or BIGSERIAL
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