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 IO (Either ByteString [Statement])
-> (Either ByteString [Statement] -> IO [Statement])
-> IO [Statement]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
parserError -> [Statement] -> IO [Statement]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Right [Statement]
statements -> [Statement] -> IO [Statement]
forall a. a -> IO a
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
    Either Text [GeneratorAction] -> IO (Either Text [GeneratorAction])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [GeneratorAction]
 -> IO (Either Text [GeneratorAction]))
-> Either Text [GeneratorAction]
-> IO (Either Text [GeneratorAction])
forall a b. (a -> b) -> a -> b
$ [GeneratorAction] -> Either Text [GeneratorAction]
forall a b. b -> Either a b
Right ([GeneratorAction] -> Either Text [GeneratorAction])
-> [GeneratorAction] -> Either Text [GeneratorAction]
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
modelName :: Text
$sel:modelName:ControllerConfig :: Text
modelName, Text
controllerName :: Text
$sel:controllerName:ControllerConfig :: Text
controllerName, Text
applicationName :: Text
$sel:applicationName:ControllerConfig :: Text
applicationName, Bool
paginationEnabled :: Bool
$sel:paginationEnabled:ControllerConfig :: 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/Controller/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/Routes.hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ControllerConfig -> Text
controllerInstance ControllerConfig
config) }
        , AppendToFile { $sel:filePath:CreateFile :: Text
filePath = Text
applicationName Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/FrontController.hs", $sel:fileContent:CreateFile :: Text
fileContent = (Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Controller." Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/FrontController.hs", $sel:fileContent:CreateFile :: Text
fileContent = (Text
"        , parseRoute @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Controller") }
        ]
        [GeneratorAction] -> [GeneratorAction] -> [GeneratorAction]
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
(ControllerConfig -> ControllerConfig -> Bool)
-> (ControllerConfig -> ControllerConfig -> Bool)
-> Eq ControllerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerConfig -> ControllerConfig -> Bool
== :: ControllerConfig -> ControllerConfig -> Bool
$c/= :: ControllerConfig -> ControllerConfig -> Bool
/= :: ControllerConfig -> ControllerConfig -> Bool
Eq, Int -> ControllerConfig -> ShowS
[ControllerConfig] -> ShowS
ControllerConfig -> String
(Int -> ControllerConfig -> ShowS)
-> (ControllerConfig -> String)
-> ([ControllerConfig] -> ShowS)
-> Show ControllerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerConfig -> ShowS
showsPrec :: Int -> ControllerConfig -> ShowS
$cshow :: ControllerConfig -> String
show :: ControllerConfig -> String
$cshowList :: [ControllerConfig] -> ShowS
showList :: [ControllerConfig] -> ShowS
Show)

controllerInstance :: ControllerConfig -> Text
controllerInstance :: ControllerConfig -> Text
controllerInstance ControllerConfig { Text
$sel:controllerName:ControllerConfig :: ControllerConfig -> Text
controllerName :: Text
controllerName, Text
$sel:modelName:ControllerConfig :: ControllerConfig -> Text
modelName :: Text
modelName, Text
$sel:applicationName:ControllerConfig :: ControllerConfig -> Text
applicationName :: Text
applicationName } =
    Text
"instance AutoRoute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
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 = ControllerConfig
config.controllerName
        pluralName :: Text
pluralName = ControllerConfig
config.controllerName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        singularName :: Text
singularName = ControllerConfig
config.modelName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        idFieldName :: Text
idFieldName = Text -> Text
lcfirst Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Id"
        idType :: Text
idType = Text
"Id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName
    in
        Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"data " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Controller\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pluralName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | New" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | Show" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | Create" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | Edit" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | Update" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    | Delete" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
singularName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: !(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") }\n"
        Text -> Text -> Text
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 = ControllerConfig
config.applicationName
        name :: Text
name = ControllerConfig
config.controllerName
        pluralName :: Text
pluralName = ControllerConfig
config.controllerName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        singularName :: Text
singularName = ControllerConfig
config.modelName Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
lcfirst Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
singularize Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
ucfirst
        moduleName :: Text
moduleName =  Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Controller." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
        controllerName :: Text
controllerName = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Controller"

        importStatements :: [Text]
importStatements =
            [ Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Controller.Prelude"
            , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"Index"
            , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"New"
            , Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControllerConfig -> Text -> Text
qualifiedViewModuleName ControllerConfig
config Text
"Edit"
            , Text
"import " Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Id"
        model :: Text
model = Text -> Text
ucfirst Text
singularName
        paginationEnabled :: Bool
paginationEnabled = ControllerConfig
config.paginationEnabled

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

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

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

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

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

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

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

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

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

        toTypeLevelList :: t1 -> Text
toTypeLevelList t1
values = Text
"@'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (t1
values t1 -> (t1 -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> t1 -> Text
forall {t1}. Show t1 => t1 -> Text
tshow Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"," Text
", ")
    in
        Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
moduleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        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
"\n" [Text]
importStatements
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"instance Controller " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indexAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
showAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
editAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
updateAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
createAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
deleteAction
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
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 =
    ControllerConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".View." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControllerConfig
config.controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
viewName

pathToModuleName :: Text -> Text
pathToModuleName :: Text -> Text
pathToModuleName Text
moduleName = HasCallStack => Text -> Text -> Text -> Text
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 Text -> Bool
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 [GeneratorAction] -> [GeneratorAction] -> [GeneratorAction]
forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
newPlan [GeneratorAction] -> [GeneratorAction] -> [GeneratorAction]
forall a. Semigroup a => a -> a -> a
<> [GeneratorAction]
showPlan [GeneratorAction] -> [GeneratorAction] -> [GeneratorAction]
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
applicationName :: Text
paginationEnabled :: Bool
viewName :: Text
modelName :: Text
controllerName :: Text
$sel:controllerName:ViewConfig :: Text
$sel:applicationName:ViewConfig :: Text
$sel:modelName:ViewConfig :: Text
$sel:viewName:ViewConfig :: Text
$sel:paginationEnabled:ViewConfig :: Bool
.. }


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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
text