module IHP.IDE.CodeGen.ViewGenerator (buildPlan, buildPlan', ViewConfig (..)) where
import IHP.Prelude
import qualified Data.Text as Text
import IHP.IDE.CodeGen.Types
import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner
import IHP.IDE.SchemaDesigner.Types
data ViewConfig = ViewConfig
{ ViewConfig -> Text
controllerName :: Text
, ViewConfig -> Text
applicationName :: Text
, ViewConfig -> Text
modelName :: Text
, ViewConfig -> Text
viewName :: Text
, :: Bool
} deriving (ViewConfig -> ViewConfig -> Bool
(ViewConfig -> ViewConfig -> Bool)
-> (ViewConfig -> ViewConfig -> Bool) -> Eq ViewConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViewConfig -> ViewConfig -> Bool
== :: ViewConfig -> ViewConfig -> Bool
$c/= :: ViewConfig -> ViewConfig -> Bool
/= :: ViewConfig -> ViewConfig -> Bool
Eq, Int -> ViewConfig -> ShowS
[ViewConfig] -> ShowS
ViewConfig -> String
(Int -> ViewConfig -> ShowS)
-> (ViewConfig -> String)
-> ([ViewConfig] -> ShowS)
-> Show ViewConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewConfig -> ShowS
showsPrec :: Int -> ViewConfig -> ShowS
$cshow :: ViewConfig -> String
show :: ViewConfig -> String
$cshowList :: [ViewConfig] -> ShowS
showList :: [ViewConfig] -> ShowS
Show)
buildPlan :: Text -> Text -> Text -> IO (Either Text [GeneratorAction])
buildPlan :: Text -> Text -> Text -> IO (Either Text [GeneratorAction])
buildPlan Text
viewName Text
applicationName Text
controllerName' =
if (Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
viewName Bool -> Bool -> Bool
|| Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
controllerName')
then 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
$ Text -> Either Text [GeneratorAction]
forall a b. a -> Either a b
Left Text
"Neither view name nor controller name can be empty"
else 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 modelName :: Text
modelName = Text -> Text
tableNameToModelName Text
controllerName'
let controllerName :: Text
controllerName = Text -> Text
tableNameToControllerName Text
controllerName'
let paginationEnabled :: Bool
paginationEnabled = Bool
False
let viewConfig :: ViewConfig
viewConfig = ViewConfig { Bool
Text
$sel:controllerName:ViewConfig :: Text
$sel:applicationName:ViewConfig :: Text
$sel:modelName:ViewConfig :: Text
$sel:viewName:ViewConfig :: Text
$sel:paginationEnabled:ViewConfig :: Bool
viewName :: Text
applicationName :: Text
modelName :: Text
controllerName :: Text
paginationEnabled :: Bool
.. }
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] -> ViewConfig -> [GeneratorAction]
buildPlan' [Statement]
schema ViewConfig
viewConfig
qualifiedViewModuleName :: ViewConfig -> Text -> Text
qualifiedViewModuleName :: ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
viewName =
ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".View." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewConfig
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
buildPlan' :: [Statement] -> ViewConfig -> [GeneratorAction]
buildPlan' :: [Statement] -> ViewConfig -> [GeneratorAction]
buildPlan' [Statement]
schema ViewConfig
config =
let
controllerName :: Text
controllerName = ViewConfig
config.controllerName
name :: Text
name = ViewConfig
config.viewName
singularName :: Text
singularName = ViewConfig
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
pluralName :: Text
pluralName = Text
singularName 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
singularVariableName :: Text
singularVariableName = Text -> Text
lcfirst Text
singularName
pluralVariableName :: Text
pluralVariableName = Text -> Text
lcfirst Text
controllerName
nameWithSuffix :: Text
nameWithSuffix = if Text
"View" Text -> Text -> Bool
`isSuffixOf` Text
name
then Text
name
else Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"View"
nameWithoutSuffix :: Text
nameWithoutSuffix = if Text
"View" Text -> Text -> Bool
`isSuffixOf` Text
name
then HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"View" Text
"" Text
name
else Text
name
indexAction :: Text
indexAction = Text
pluralName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Action"
specialCases :: [(Text, Text)]
specialCases = [
(Text
"IndexView", Text
indexView)
, (Text
"ShowView", Text
showView)
, (Text
"EditView", Text
editView)
, (Text
"NewView", Text
newView)
]
paginationEnabled :: Bool
paginationEnabled = ViewConfig
config.paginationEnabled
modelFields :: [Text]
modelFields :: [Text]
modelFields = [ Text -> Text
modelNameToTableName Text
pluralVariableName, Text
pluralVariableName ]
[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]
forall a. [a] -> Maybe a
head
Maybe [Text] -> (Maybe [Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe []
qqClose :: Text
qqClose = Text
"|]"
viewHeader :: Text
viewHeader = [trimming|
module ${moduleName} where
import ${applicationName}.View.Prelude
|]
where
moduleName :: Text
moduleName = ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
nameWithoutSuffix
applicationName :: Text
applicationName = ViewConfig
config.applicationName
genericView :: Text
genericView = [trimming|
${viewHeader}
data ${nameWithSuffix} = {$nameWithSuffix}
instance View ${nameWithSuffix} where
html ${nameWithSuffix} { .. } = [hsx|
{breadcrumb}
<h1>${nameWithSuffix}</h1>
${qqClose}
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "${pluralizedName}" ${indexAction}
, breadcrumbText "${nameWithSuffix}"
]
|]
where
pluralizedName :: Text
pluralizedName = Text -> Text
pluralize Text
name
showView :: Text
showView = [trimming|
${viewHeader}
data ShowView = ShowView { ${singularVariableName} :: ${singularName} }
instance View ShowView where
html ShowView { .. } = [hsx|
{breadcrumb}
<h1>Show ${singularName}</h1>
<p>{${singularVariableName}}</p>
${qqClose}
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "${pluralName}" ${indexAction}
, breadcrumbText "Show ${singularName}"
]
|]
renderForm :: Text
renderForm = [trimming|
renderForm :: ${singularName} -> Html
renderForm ${singularVariableName} = formFor ${singularVariableName} [hsx|
${formFields}
{submitButton}
${qqClose}
|]
where
formFields :: Text
formFields =
Text -> [Text] -> Text
intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
field -> Text
"{(textField #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")}") [Text]
modelFields)
newView :: Text
newView = [trimming|
${viewHeader}
data NewView = NewView { ${singularVariableName} :: ${singularName} }
instance View NewView where
html NewView { .. } = [hsx|
{breadcrumb}
<h1>New ${singularName}</h1>
{renderForm ${singularVariableName}}
${qqClose}
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "${pluralName}" ${indexAction}
, breadcrumbText "New ${singularName}"
]
${renderForm}
|]
editView :: Text
editView = [trimming|
${viewHeader}
data EditView = EditView { ${singularVariableName} :: ${singularName} }
instance View EditView where
html EditView { .. } = [hsx|
{breadcrumb}
<h1>Edit ${singularName}</h1>
{renderForm ${singularVariableName}}
${qqClose}
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "${pluralName}" ${indexAction}
, breadcrumbText "Edit ${singularName}"
]
${renderForm}
|]
indexView :: Text
indexView = [trimming|
${viewHeader}
data IndexView = IndexView { ${pluralVariableName} :: [${singularName}]${importPagination} }
instance View IndexView where
html IndexView { .. } = [hsx|
{breadcrumb}
<h1>${nameWithoutSuffix}<a href={pathTo New${singularName}Action} class="btn btn-primary ms-4">+ New</a></h1>
<div class="table-responsive">
<table class="table">
<thead>
<tr>
<th>${singularName}</th>
<th></th>
<th></th>
<th></th>
</tr>
</thead>
<tbody>{forEach ${pluralVariableName} render${singularName}}</tbody>
</table>
${renderPagination}
</div>
${qqClose}
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "${pluralName}" ${indexAction}
]
render${singularName} :: ${singularName} -> Html
render${singularName} ${singularVariableName} = [hsx|
<tr>
<td>{${singularVariableName}}</td>
<td><a href={Show${singularName}Action ${singularVariableName}.id}>Show</a></td>
<td><a href={Edit${singularName}Action ${singularVariableName}.id} class="text-muted">Edit</a></td>
<td><a href={Delete${singularName}Action ${singularVariableName}.id} class="js-delete text-muted">Delete</a></td>
</tr>
${qqClose}
|]
where
importPagination :: Text
importPagination = if Bool
paginationEnabled then Text
", pagination :: Pagination" else Text
""
renderPagination :: Text
renderPagination = if Bool
paginationEnabled then Text
"{renderPagination pagination}" else Text
""
chosenView :: Text
chosenView = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
genericView (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
nameWithSuffix [(Text, Text)]
specialCases)
in
[ EnsureDirectory { $sel:directory:CreateFile :: Text
directory = ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/View/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName }
, CreateFile { $sel:filePath:CreateFile :: Text
filePath = ViewConfig
config.applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/View/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
controllerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameWithoutSuffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".hs", $sel:fileContent:CreateFile :: Text
fileContent = Text
chosenView }
, AddImport { $sel:filePath:CreateFile :: Text
filePath = ViewConfig
config.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 = Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewConfig -> Text -> Text
qualifiedViewModuleName ViewConfig
config Text
nameWithoutSuffix }
]