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
, :: 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
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