module IHP.IDE.CodeGen.ControllerGenerator (buildPlan, buildPlan') where

import ClassyPrelude
import IHP.NameSupport
import IHP.HaskellSupport
import qualified Data.Text as Text
import qualified Data.Char as Char
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner
import IHP.IDE.SchemaDesigner.Types
import IHP.IDE.CodeGen.Types
import qualified IHP.IDE.CodeGen.ViewGenerator as ViewGenerator


buildPlan :: Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
buildPlan :: Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
buildPlan Text
rawControllerName Text
applicationName Bool
paginationEnabled = do
    [Statement]
schema <- IO (Either ByteString [Statement])
SchemaDesigner.parseSchemaSql forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
parserError -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Right [Statement]
statements -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
statements
    let controllerName :: Text
controllerName = Text -> Text
tableNameToControllerName Text
rawControllerName
    let modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
rawControllerName
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Statement] -> Text -> Text -> Text -> Bool -> [GeneratorAction]
buildPlan' [Statement]
schema Text
applicationName Text
controllerName Text
modelName Bool
paginationEnabled

buildPlan' :: [Statement] -> Text -> Text -> Text -> Bool -> [GeneratorAction]
buildPlan' [Statement]
schema Text
applicationName Text
controllerName Text
modelName Bool
paginationEnabled =
    let
        config :: ControllerConfig
config = ControllerConfig { Text
$sel:modelName:ControllerConfig :: Text
modelName :: Text
modelName, Text
$sel:controllerName:ControllerConfig :: Text
controllerName :: Text
controllerName, Text
$sel:applicationName:ControllerConfig :: Text
applicationName :: Text
applicationName, Bool
$sel:paginationEnabled:ControllerConfig :: Bool
paginationEnabled :: Bool
paginationEnabled }
        viewPlans :: [GeneratorAction]
viewPlans = [Statement] -> Text -> Text -> Bool -> [GeneratorAction]
generateViews [Statement]
schema Text
applicationName Text
controllerName Bool
paginationEnabled
    in
        [ CreateFile { $sel:filePath:CreateFile :: Text
filePath = Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
"/Controller/" forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = ([Statement] -> ControllerConfig -> Text
generateController [Statement]
schema ControllerConfig
config) }
        , AppendToFile { $sel:filePath:CreateFile :: Text
filePath = Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
"/Routes.hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
"\n" forall a. Semigroup a => a -> a -> a
<> (ControllerConfig -> Text
controllerInstance ControllerConfig
config) }
        , AppendToFile { $sel:filePath:CreateFile :: Text
filePath = Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
"/Types.hs", $sel:fileContent:CreateFile :: Text
fileContent = (ControllerConfig -> Text
generateControllerData ControllerConfig
config) }
        , AppendToMarker { $sel:marker:CreateFile :: Text
marker = Text
"-- Controller Imports", $sel:filePath:CreateFile :: Text
filePath = Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
"/FrontController.hs", $sel:fileContent:CreateFile :: Text
fileContent = (Text
"import " forall a. Semigroup a => a -> a -> a
<> Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
".Controller." forall a. Semigroup a => a -> a -> a
<> Text
controllerName) }
        , AppendToMarker { $sel:marker:CreateFile :: Text
marker = Text
"-- Generator Marker", $sel:filePath:CreateFile :: Text
filePath = Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
"/FrontController.hs", $sel:fileContent:CreateFile :: Text
fileContent = (Text
"        , parseRoute @" forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
"Controller") }
        ]
        forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
viewPlans

data ControllerConfig = ControllerConfig
    { ControllerConfig -> Text
controllerName :: Text
    , ControllerConfig -> Text
applicationName :: Text
    , ControllerConfig -> Text
modelName :: Text
    , ControllerConfig -> Bool
paginationEnabled :: Bool
    } deriving (ControllerConfig -> ControllerConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerConfig -> ControllerConfig -> Bool
$c/= :: ControllerConfig -> ControllerConfig -> Bool
== :: ControllerConfig -> ControllerConfig -> Bool
$c== :: ControllerConfig -> ControllerConfig -> Bool
Eq, Int -> ControllerConfig -> ShowS
[ControllerConfig] -> ShowS
ControllerConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerConfig] -> ShowS
$cshowList :: [ControllerConfig] -> ShowS
show :: ControllerConfig -> String
$cshow :: ControllerConfig -> String
showsPrec :: Int -> ControllerConfig -> ShowS
$cshowsPrec :: Int -> ControllerConfig -> ShowS
Show)

controllerInstance :: ControllerConfig -> Text
controllerInstance :: ControllerConfig -> Text
controllerInstance ControllerConfig { Text
controllerName :: Text
$sel:controllerName:ControllerConfig :: ControllerConfig -> Text
controllerName, Text
modelName :: Text
$sel:modelName:ControllerConfig :: ControllerConfig -> Text
modelName, Text
applicationName :: Text
$sel:applicationName:ControllerConfig :: ControllerConfig -> Text
applicationName } =
    Text
"instance AutoRoute " forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
"Controller\n\n"

data HaskellModule = HaskellModule { HaskellModule -> Text
moduleName :: Text, HaskellModule -> Text
body :: Text }

generateControllerData :: ControllerConfig -> Text
generateControllerData :: ControllerConfig -> Text
generateControllerData ControllerConfig
config =
    let
        name :: Text
name = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ControllerConfig
config
        pluralName :: Text
pluralName = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ControllerConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        singularName :: Text
singularName = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "modelName" a => a
#modelName ControllerConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        idFieldName :: Text
idFieldName = Text -> Text
lcfirst Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Id"
        idType :: Text
idType = Text
"Id " forall a. Semigroup a => a -> a -> a
<> Text
singularName
    in
        Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"data " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"Controller\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    = " forall a. Semigroup a => a -> a -> a
<> Text
pluralName forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | New" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | Show" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" forall a. Semigroup a => a -> a -> a
<> Text
idType forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | Create" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | Edit" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" forall a. Semigroup a => a -> a -> a
<> Text
idType forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | Update" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" forall a. Semigroup a => a -> a -> a
<> Text
idType forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    | Delete" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" forall a. Semigroup a => a -> a -> a
<> Text
idType forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"    deriving (Eq, Show, Data)\n"

generateController :: [Statement] -> ControllerConfig -> Text
generateController :: [Statement] -> ControllerConfig -> Text
generateController [Statement]
schema ControllerConfig
config =
    let
        applicationName :: Text
applicationName = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ControllerConfig
config
        name :: Text
name = ControllerConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName
        pluralName :: Text
pluralName = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ControllerConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        singularName :: Text
singularName = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "modelName" a => a
#modelName ControllerConfig
config forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        moduleName :: Text
moduleName =  Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
".Controller." forall a. Semigroup a => a -> a -> a
<> Text
name
        controllerName :: Text
controllerName = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"Controller"

        importStatements :: [Text]
importStatements =
            [ Text
"import " forall a. Semigroup a => a -> a -> a
<> Text
applicationName forall a. Semigroup a => a -> a -> a
<> Text
".Controller.Prelude"
            , Text
"import " forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"Index"
            , Text
"import " forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"New"
            , Text
"import " forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"Edit"
            , Text
"import " forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"Show"

            ]

        modelVariablePlural :: Text
modelVariablePlural = Text -> Text
lcfirst Text
name
        modelVariableSingular :: Text
modelVariableSingular = Text -> Text
lcfirst Text
singularName
        idFieldName :: Text
idFieldName = Text -> Text
lcfirst Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Id"
        model :: Text
model = Text -> Text
ucfirst Text
singularName
        paginationEnabled :: Bool
paginationEnabled = forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "paginationEnabled" a => a
#paginationEnabled ControllerConfig
config

        indexAction :: Text
indexAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action " forall a. Semigroup a => a -> a -> a
<> Text
pluralName forall a. Semigroup a => a -> a -> a
<> Text
"Action = do\n"
            forall a. Semigroup a => a -> a -> a
<> (if Bool
paginationEnabled
                then   Text
"        (" forall a. Semigroup a => a -> a -> a
<> Text
modelVariablePlural forall a. Semigroup a => a -> a -> a
<> Text
"Q, pagination) <- query @" forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
" |> paginate\n"
                    forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariablePlural forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Text
modelVariablePlural forall a. Semigroup a => a -> a -> a
<> Text
"Q |> fetch\n"
                else Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariablePlural forall a. Semigroup a => a -> a -> a
<> Text
" <- query @" forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
" |> fetch\n"
            )
            forall a. Semigroup a => a -> a -> a
<> Text
"        render IndexView { .. }\n"

        newAction :: Text
newAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action New" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        let " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" = newRecord\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        render NewView { .. }\n"

        showAction :: Text
showAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action Show" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" } = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- fetch " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        render ShowView { .. }\n"

        editAction :: Text
editAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action Edit" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" } = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- fetch " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        render EditView { .. }\n"

        modelFields :: [Text]
        modelFields :: [Text]
modelFields = [ Text -> Text
modelNameToTableName Text
modelVariableSingular, Text
modelVariableSingular ]
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Statement] -> Text -> Maybe [Text]
fieldsForTable [Statement]
schema)
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. a -> Maybe a -> a
fromMaybe []

        updateAction :: Text
updateAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action Update" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" } = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- fetch " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"            |> build" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"            |> ifValid \\case\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                Left " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" -> render EditView { .. }\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                Right " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" -> do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" |> updateRecord\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    setSuccessMessage \"" forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
" updated\"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    redirectTo Edit" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { .. }\n"

        createAction :: Text
createAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action Create" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        let " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" = newRecord @"  forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"            |> build" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"            |> ifValid \\case\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                Left " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" -> render NewView { .. } \n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                Right " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" -> do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" |> createRecord\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    setSuccessMessage \"" forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
" created\"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"                    redirectTo " forall a. Semigroup a => a -> a -> a
<> Text
pluralName forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"

        deleteAction :: Text
deleteAction =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"    action Delete" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
"Action { " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
" } = do\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" <- fetch " forall a. Semigroup a => a -> a -> a
<> Text
idFieldName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        deleteRecord " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        setSuccessMessage \"" forall a. Semigroup a => a -> a -> a
<> Text
model forall a. Semigroup a => a -> a -> a
<> Text
" deleted\"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"        redirectTo " forall a. Semigroup a => a -> a -> a
<> Text
pluralName forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"

        fromParams :: Text
fromParams =
            Text
""
            forall a. Semigroup a => a -> a -> a
<> Text
"build" forall a. Semigroup a => a -> a -> a
<> Text
singularName forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Text
modelVariableSingular forall a. Semigroup a => a -> a -> a
<> Text
"\n"
            forall a. Semigroup a => a -> a -> a
<> Text
"    |> fill " forall a. Semigroup a => a -> a -> a
<> forall {t1}. (MonoFoldable t1, Show t1) => t1 -> Text
toTypeLevelList [Text]
modelFields forall a. Semigroup a => a -> a -> a
<> Text
"\n"

        toTypeLevelList :: t1 -> Text
toTypeLevelList t1
values = Text
"@" forall a. Semigroup a => a -> a -> a
<> (if forall mono. MonoFoldable mono => mono -> Int
length t1
values forall a. Ord a => a -> a -> Bool
< Int
2 then Text
"'" else Text
"") forall a. Semigroup a => a -> a -> a
<> (t1
values forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a. Show a => a -> Text
tshow forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text -> Text -> Text
Text.replace Text
"," Text
", ")
    in
        Text
""
        forall a. Semigroup a => a -> a -> a
<> Text
"module " forall a. Semigroup a => a -> a -> a
<> Text
moduleName forall a. Semigroup a => a -> a -> a
<> Text
" where" forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Text
"\n" [Text]
importStatements
        forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        forall a. Semigroup a => a -> a -> a
<> Text
"instance Controller " forall a. Semigroup a => a -> a -> a
<> Text
controllerName forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
        forall a. Semigroup a => a -> a -> a
<> Text
indexAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
newAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
showAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
editAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
updateAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
createAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
deleteAction
        forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        forall a. Semigroup a => a -> a -> a
<> Text
fromParams

-- E.g. qualifiedViewModuleName config "Edit" == "Web.View.Users.Edit"
qualifiedViewModuleName :: ControllerConfig -> Text -> Text
qualifiedViewModuleName :: ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
viewName =
    forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "applicationName" a => a
#applicationName ControllerConfig
config forall a. Semigroup a => a -> a -> a
<> Text
".View." forall a. Semigroup a => a -> a -> a
<> forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "controllerName" a => a
#controllerName ControllerConfig
config forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
viewName

pathToModuleName :: Text -> Text
pathToModuleName :: Text -> Text
pathToModuleName Text
moduleName = Text -> Text -> Text -> Text
Text.replace Text
"." Text
"/" Text
moduleName

generateViews :: [Statement] -> Text -> Text -> Bool -> [GeneratorAction]
generateViews :: [Statement] -> Text -> Text -> Bool -> [GeneratorAction]
generateViews [Statement]
schema Text
applicationName Text
controllerName' Bool
paginationEnabled =
    if forall mono. MonoFoldable mono => mono -> Bool
null Text
controllerName'
        then []
        else do
            let indexPlan :: [GeneratorAction]
indexPlan = [Statement] -> ViewConfig -> [GeneratorAction]
ViewGenerator.buildPlan' [Statement]
schema (Text -> ViewConfig
config Text
"IndexView")
            let newPlan :: [GeneratorAction]
newPlan = [Statement] -> ViewConfig -> [GeneratorAction]
ViewGenerator.buildPlan' [Statement]
schema (Text -> ViewConfig
config Text
"NewView")
            let showPlan :: [GeneratorAction]
showPlan = [Statement] -> ViewConfig -> [GeneratorAction]
ViewGenerator.buildPlan' [Statement]
schema (Text -> ViewConfig
config Text
"ShowView")
            let editPlan :: [GeneratorAction]
editPlan = [Statement] -> ViewConfig -> [GeneratorAction]
ViewGenerator.buildPlan' [Statement]
schema (Text -> ViewConfig
config Text
"EditView")
            [GeneratorAction]
indexPlan forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
newPlan forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
showPlan forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
editPlan
    where
        config :: Text -> ViewConfig
config Text
viewName = do
            let modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
controllerName'
            let controllerName :: Text
controllerName = Text -> Text
tableNameToControllerName Text
controllerName'
            ViewGenerator.ViewConfig { Bool
Text
$sel:paginationEnabled:ViewConfig :: Bool
$sel:viewName:ViewConfig :: Text
$sel:modelName:ViewConfig :: Text
$sel:applicationName:ViewConfig :: Text
$sel:controllerName:ViewConfig :: Text
controllerName :: Text
modelName :: Text
viewName :: Text
paginationEnabled :: Bool
applicationName :: Text
.. }


isAlphaOnly :: Text -> Bool
isAlphaOnly :: Text -> Bool
isAlphaOnly Text
text = (Char -> Bool) -> Text -> Bool
Text.all (\Char
c -> Char -> Bool
Char.isAlpha Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_') Text
text