module IHP.IDE.CodeGen.Controller where

import IHP.ControllerPrelude hiding (appPort)
import IHP.IDE.ToolServer.Types
import IHP.IDE.CodeGen.View.Generators
import IHP.IDE.CodeGen.View.NewController
import IHP.IDE.CodeGen.View.NewScript
import IHP.IDE.CodeGen.View.NewView
import IHP.IDE.CodeGen.View.NewMail
import IHP.IDE.CodeGen.View.NewAction
import IHP.IDE.CodeGen.View.NewApplication
import IHP.IDE.CodeGen.View.NewJob
import IHP.IDE.CodeGen.Types
import IHP.IDE.CodeGen.ControllerGenerator as ControllerGenerator
import IHP.IDE.CodeGen.ScriptGenerator as ScriptGenerator
import IHP.IDE.CodeGen.ViewGenerator as ViewGenerator
import IHP.IDE.CodeGen.MailGenerator as MailGenerator
import IHP.IDE.CodeGen.ActionGenerator as ActionGenerator
import IHP.IDE.CodeGen.ApplicationGenerator as ApplicationGenerator
import IHP.IDE.CodeGen.JobGenerator as JobGenerator
import IHP.IDE.ToolServer.Helper.Controller
import qualified System.Process as Process
import qualified System.Directory as Directory
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Text.Inflections as Inflector
import System.Directory

instance Controller CodeGenController where
    action :: (?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::CodeGenController) =>
CodeGenController -> IO ()
action CodeGenController
GeneratorsAction = do
        GeneratorsView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render GeneratorsView
GeneratorsView

    action CodeGenController
NewControllerAction = do
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let pagination :: Bool
pagination = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
False ByteString
"pagination"
        Bool
controllerAlreadyExists <- Text -> Text -> IO Bool
forall {a} {a}.
(ConvertibleStrings a FilePath, ConvertibleStrings a FilePath) =>
a -> a -> IO Bool
doesControllerExist Text
controllerName Text
applicationName
        [Text]
applications <- IO [Text]
findApplications
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
controllerAlreadyExists do
            (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setErrorMessage Text
"Controller with this name does already exist."
            CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
NewControllerAction
        Either Text [GeneratorAction]
plan <- Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
ControllerGenerator.buildPlan Text
controllerName Text
applicationName Bool
pagination
        NewControllerView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewControllerView { Bool
[Text]
Either Text [GeneratorAction]
Text
controllerName :: Text
applicationName :: Text
pagination :: Bool
applications :: [Text]
plan :: Either Text [GeneratorAction]
$sel:plan:NewControllerView :: Either Text [GeneratorAction]
$sel:controllerName:NewControllerView :: Text
$sel:applicationName:NewControllerView :: Text
$sel:applications:NewControllerView :: [Text]
$sel:pagination:NewControllerView :: Bool
.. }
        where
            doesControllerExist :: a -> a -> IO Bool
doesControllerExist a
controllerName a
applicationName = FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs a
applicationName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/Controller/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs a
controllerName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".hs"

    action CodeGenController
CreateControllerAction = do
        let controllerName :: Text
controllerName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"name"
        let applicationName :: Text
applicationName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"applicationName"
        let pagination :: Bool
pagination = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
False ByteString
"pagination"
        (Right [GeneratorAction]
plan) <- Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
ControllerGenerator.buildPlan Text
controllerName Text
applicationName Bool
pagination
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Controller generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewScriptAction = do
        let scriptName :: Text
scriptName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        Bool
scriptAlreadyExists <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"Application/Script/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
scriptName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".hs"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
scriptAlreadyExists do
            (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setErrorMessage Text
"Script with this name already exists."
            CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
NewScriptAction
        let plan :: Either Text [GeneratorAction]
plan = Text -> Either Text [GeneratorAction]
ScriptGenerator.buildPlan Text
scriptName
        NewScriptView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewScriptView { Either Text [GeneratorAction]
Text
scriptName :: Text
plan :: Either Text [GeneratorAction]
$sel:plan:NewScriptView :: Either Text [GeneratorAction]
$sel:scriptName:NewScriptView :: Text
.. }

    action CodeGenController
CreateScriptAction = do
        let scriptName :: Text
scriptName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let (Right [GeneratorAction]
plan) = Text -> Either Text [GeneratorAction]
ScriptGenerator.buildPlan Text
scriptName
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Script generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewViewAction = do
        let viewName :: Text
viewName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        Bool
viewAlreadyExists <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
applicationName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/View/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
controllerName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
viewName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>FilePath
".hs"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
viewAlreadyExists do
            (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setErrorMessage Text
"View with this name already exists."
            CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
NewViewAction
        [Text]
controllers <- Text -> IO [Text]
findControllers Text
applicationName
        [Text]
applications <- IO [Text]
findApplications
        Either Text [GeneratorAction]
plan <- Text -> Text -> Text -> IO (Either Text [GeneratorAction])
ViewGenerator.buildPlan Text
viewName Text
applicationName Text
controllerName
        NewViewView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewViewView { [Text]
Either Text [GeneratorAction]
Text
viewName :: Text
applicationName :: Text
controllerName :: Text
controllers :: [Text]
applications :: [Text]
plan :: Either Text [GeneratorAction]
$sel:plan:NewViewView :: Either Text [GeneratorAction]
$sel:viewName:NewViewView :: Text
$sel:controllerName:NewViewView :: Text
$sel:applicationName:NewViewView :: Text
$sel:controllers:NewViewView :: [Text]
$sel:applications:NewViewView :: [Text]
.. }

    action CodeGenController
CreateViewAction = do
        let viewName :: Text
viewName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        (Right [GeneratorAction]
plan) <- Text -> Text -> Text -> IO (Either Text [GeneratorAction])
ViewGenerator.buildPlan Text
viewName Text
applicationName Text
controllerName
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"View generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewMailAction = do
        let mailName :: Text
mailName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        Bool
mailAlreadyExists <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
applicationName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/Mail/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
controllerName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
mailName) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>FilePath
".hs"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mailAlreadyExists do
            (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setErrorMessage Text
"Mail with this name already exists."
            CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
NewMailAction
        [Text]
controllers <- Text -> IO [Text]
findControllers Text
applicationName
        [Text]
applications <- IO [Text]
findApplications
        Either Text [GeneratorAction]
plan <- Text -> Text -> Text -> IO (Either Text [GeneratorAction])
MailGenerator.buildPlan Text
mailName Text
applicationName Text
controllerName
        NewMailView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewMailView { [Text]
Either Text [GeneratorAction]
Text
mailName :: Text
applicationName :: Text
controllerName :: Text
controllers :: [Text]
applications :: [Text]
plan :: Either Text [GeneratorAction]
$sel:plan:NewMailView :: Either Text [GeneratorAction]
$sel:mailName:NewMailView :: Text
$sel:controllerName:NewMailView :: Text
$sel:applicationName:NewMailView :: Text
$sel:controllers:NewMailView :: [Text]
$sel:applications:NewMailView :: [Text]
.. }

    action CodeGenController
CreateMailAction = do
        let mailName :: Text
mailName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        (Right [GeneratorAction]
plan) <- Text -> Text -> Text -> IO (Either Text [GeneratorAction])
MailGenerator.buildPlan Text
mailName Text
applicationName Text
controllerName
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Mail generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewActionAction = do
        let actionName :: Text
actionName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        let doGenerateView :: Bool
doGenerateView = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
False ByteString
"doGenerateView"
        [Text]
controllers <- IO [Text]
findWebControllers
        [Text]
applications <- IO [Text]
findApplications
        Either Text [GeneratorAction]
plan <- Text -> Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
ActionGenerator.buildPlan Text
actionName Text
applicationName Text
controllerName Bool
doGenerateView
        NewActionView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewActionView { Bool
[Text]
Either Text [GeneratorAction]
Text
actionName :: Text
applicationName :: Text
controllerName :: Text
doGenerateView :: Bool
controllers :: [Text]
applications :: [Text]
plan :: Either Text [GeneratorAction]
$sel:plan:NewActionView :: Either Text [GeneratorAction]
$sel:actionName:NewActionView :: Text
$sel:controllerName:NewActionView :: Text
$sel:applicationName:NewActionView :: Text
$sel:doGenerateView:NewActionView :: Bool
$sel:controllers:NewActionView :: [Text]
$sel:applications:NewActionView :: [Text]
.. }

    action CodeGenController
CreateActionAction = do
        let actionName :: Text
actionName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        let controllerName :: Text
controllerName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"controllerName"
        let doGenerateView :: Bool
doGenerateView = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
False ByteString
"doGenerateView"
        (Right [GeneratorAction]
plan) <- Text -> Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
ActionGenerator.buildPlan Text
actionName Text
applicationName Text
controllerName Bool
doGenerateView
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Action" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ (if Bool
doGenerateView then Text
" and View " else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
++ Text
" generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewApplicationAction = do
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        Either Text [GeneratorAction]
plan <- Text -> IO (Either Text [GeneratorAction])
ApplicationGenerator.buildPlan Text
applicationName
        NewApplicationView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewApplicationView { Either Text [GeneratorAction]
Text
applicationName :: Text
plan :: Either Text [GeneratorAction]
$sel:plan:NewApplicationView :: Either Text [GeneratorAction]
$sel:applicationName:NewApplicationView :: Text
.. }

    action CodeGenController
CreateApplicationAction = do
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        (Right [GeneratorAction]
plan) <- Text -> IO (Either Text [GeneratorAction])
ApplicationGenerator.buildPlan Text
applicationName
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Application generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
NewJobAction = do
        let jobName :: Text
jobName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        [Text]
controllers <- Text -> IO [Text]
findControllers Text
applicationName
        [Text]
applications <- IO [Text]
findApplications
        Either Text [GeneratorAction]
plan <- Text -> Text -> IO (Either Text [GeneratorAction])
JobGenerator.buildPlan Text
jobName Text
applicationName
        NewJobView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewJobView { [Text]
Either Text [GeneratorAction]
Text
jobName :: Text
applicationName :: Text
applications :: [Text]
plan :: Either Text [GeneratorAction]
$sel:plan:NewJobView :: Either Text [GeneratorAction]
$sel:jobName:NewJobView :: Text
$sel:applicationName:NewJobView :: Text
$sel:applications:NewJobView :: [Text]
.. }

    action CodeGenController
CreateJobAction = do
        let jobName :: Text
jobName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"name"
        let applicationName :: Text
applicationName = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"Web" ByteString
"applicationName"
        (Right [GeneratorAction]
plan) <- Text -> Text -> IO (Either Text [GeneratorAction])
JobGenerator.buildPlan Text
jobName Text
applicationName
        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan
        (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Job generated"
        CodeGenController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo CodeGenController
GeneratorsAction

    action CodeGenController
OpenControllerAction = do
        let name :: Text
name = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"name"
        case Text
name Text
-> (Text -> Either (ParseErrorBundle Text Void) Text)
-> Either (ParseErrorBundle Text Void) Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Bool -> Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toCamelCased Bool
True of
            Left ParseErrorBundle Text Void
error -> (?context::ControllerContext) => LByteString -> IO ()
LByteString -> IO ()
renderPlain LByteString
"Failed to transform name to camel case"
            Right Text
indexActionName-> (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToUrl (Text
"http://localhost:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PortNumber -> Text
forall a. Show a => a -> Text
tshow PortNumber
(?context::ControllerContext) => PortNumber
appPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indexActionName)


executePlan :: [GeneratorAction] -> IO ()
executePlan :: [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
actions = [GeneratorAction] -> (Element [GeneratorAction] -> IO ()) -> IO ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forEach [GeneratorAction]
actions Element [GeneratorAction] -> IO ()
GeneratorAction -> IO ()
evalAction
    where
        evalAction :: GeneratorAction -> IO ()
evalAction CreateFile { Text
filePath :: Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath, Text
fileContent :: Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent } = do
            FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
fileContent)
            Text -> IO ()
putStrLn (Text
"+ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
        evalAction AppendToFile { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            FilePath -> Text -> IO ()
Text.appendFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) Text
fileContent
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
        evalAction AppendToMarker { Text
marker :: Text
$sel:marker:CreateFile :: GeneratorAction -> Text
marker, Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            Text
content <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath)
            let newContent :: Text
newContent = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
marker (Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
fileContent) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
content)
            FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
newContent)
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (import)")
        evalAction AddImport { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            Text -> Text -> IO ()
addImport Text
filePath Text
fileContent
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (import)")
        evalAction AddAction { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            Text -> [Text] -> IO ()
addAction Text
filePath [Text
fileContent]
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (AddAction)")
        evalAction AddMountToFrontController { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
applicationName :: Text
$sel:applicationName:CreateFile :: GeneratorAction -> Text
applicationName } = do
            Text -> Text -> IO ()
addMountControllerStatement Text
filePath Text
applicationName
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (AddMountToFrontController)")
        evalAction AddToDataConstructor { Text
dataConstructor :: Text
$sel:dataConstructor:CreateFile :: GeneratorAction -> Text
dataConstructor, Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            Text
content <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath)
            case Text -> Text -> Text -> Maybe Text
addToDataConstructor Text
content Text
dataConstructor Text
fileContent of
                Just Text
newContent -> do
                    FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
newContent)
                    Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (AddToDataConstructor)")
                Maybe Text
Nothing -> Text -> IO ()
putStrLn (Text
"Could not automatically add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
        evalAction EnsureDirectory { Text
directory :: Text
$sel:directory:CreateFile :: GeneratorAction -> Text
directory } = do
            Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
directory)
        evalAction RunShellCommand { Text
shellCommand :: Text
$sel:shellCommand:CreateFile :: GeneratorAction -> Text
shellCommand } = do
            ExitCode
_ <- FilePath -> IO ExitCode
Process.system (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
shellCommand)
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
shellCommand)

undoPlan :: [GeneratorAction] -> IO()
undoPlan :: [GeneratorAction] -> IO ()
undoPlan [GeneratorAction]
actions = [GeneratorAction] -> (Element [GeneratorAction] -> IO ()) -> IO ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forEach [GeneratorAction]
actions Element [GeneratorAction] -> IO ()
GeneratorAction -> IO ()
evalAction
    where
        evalAction :: GeneratorAction -> IO ()
evalAction CreateFile { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            (FilePath -> IO ()
Directory.removeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath)) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
        evalAction AppendToFile { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            Text -> Text -> IO ()
deleteTextFromFile (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) Text
fileContent IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
        evalAction AppendToMarker { Text
$sel:marker:CreateFile :: GeneratorAction -> Text
marker :: Text
marker, Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            (Text -> Text -> IO ()
deleteTextFromFile (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text
fileContent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (import)")
        evalAction AddImport { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            (Text -> Text -> IO ()
deleteTextFromFile (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text
fileContent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (import)")
        evalAction AddAction { Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            (Text -> Text -> IO ()
deleteTextFromFile (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text
fileContent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (RemoveAction)")
        evalAction AddToDataConstructor { Text
$sel:dataConstructor:CreateFile :: GeneratorAction -> Text
dataConstructor :: Text
dataConstructor, Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: Text
filePath, Text
$sel:fileContent:CreateFile :: GeneratorAction -> Text
fileContent :: Text
fileContent } = do
            (Text -> Text -> IO ()
deleteTextFromFile (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text
fileContent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
            Text -> IO ()
putStrLn (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (RemoveFromDataConstructor)")
        evalAction EnsureDirectory { Text
$sel:directory:CreateFile :: GeneratorAction -> Text
directory :: Text
directory } = do
            (FilePath -> IO ()
Directory.removeDirectory (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
directory)) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ()
handleError
        evalAction RunShellCommand { Text
$sel:shellCommand:CreateFile :: GeneratorAction -> Text
shellCommand :: Text
shellCommand } = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        handleError :: SomeException -> IO ()
        handleError :: SomeException -> IO ()
handleError SomeException
ex = Text -> IO ()
putStrLn (SomeException -> Text
forall a. Show a => a -> Text
tshow SomeException
ex)

deleteTextFromFile :: Text -> Text -> IO ()
deleteTextFromFile :: Text -> Text -> IO ()
deleteTextFromFile Text
filePath Text
lineContent = do
    Text
fileContent <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath)
    let replacedContent :: Text
replacedContent = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
lineContent Text
"" Text
fileContent
    FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) Text
replacedContent

addImport :: Text -> Text -> IO ()
addImport :: Text -> Text -> IO ()
addImport Text
file Text
importStatement = do
    Text
content :: Text <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
file)
    case Text -> Text -> Maybe Text
addImport' Text
content Text
importStatement of
        Just Text
newContent -> FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
file) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
newContent)
        Maybe Text
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

addImport' :: Text -> Text -> Maybe Text
addImport' :: Text -> Text -> Maybe Text
addImport' Text
content Text
importStatement = do
    if Text
importStatement Text -> Text -> Bool
`isInfixOf` Text
content
        then Maybe Text
forall a. Maybe a
Nothing
        else Text -> (Text -> Bool) -> [Text] -> Maybe Text
appendLineAfter Text
content (Text
"import" `isPrefixOf`) [Text
importStatement]

addAction :: Text -> [Text] -> IO ()
addAction :: Text -> [Text] -> IO ()
addAction Text
filePath [Text]
fileContent = do
    Text
content <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath)
    case Text -> [Text] -> Maybe Text
addAction' Text
content [Text]
fileContent of
        Just Text
newContent -> FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
filePath) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
newContent)
        Maybe Text
Nothing -> Text -> IO ()
putStrLn (Text
"Could not automatically add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filePath)
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

addAction' :: Text -> [Text] -> Maybe Text
addAction' :: Text -> [Text] -> Maybe Text
addAction' Text
fileContent = Text -> (Text -> Bool) -> [Text] -> Maybe Text
appendLineAfter Text
fileContent (Text
"instance Controller" `isPrefixOf`)

addMountControllerStatement :: Text -> Text -> IO ()
addMountControllerStatement :: Text -> Text -> IO ()
addMountControllerStatement Text
file Text
applicationName = do
    Text
content :: Text <- FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
file)
    case Text -> Text -> Maybe Text
addMountControllerStatement' Text
applicationName Text
content of
        Just Text
newContent -> FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
file) (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
newContent)
        Maybe Text
Nothing -> Text -> IO ()
putStrLn (Text
"Could not automatically add " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
file)
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

addMountControllerStatement' :: Text -> Text -> Maybe Text
addMountControllerStatement' :: Text -> Text -> Maybe Text
addMountControllerStatement' Text
applicationName Text
file =
    let withMaybeMountedFrontController :: Maybe Text
withMaybeMountedFrontController = Text -> (Text -> Bool) -> [Text] -> Maybe Text
appendLineAfter Text
file (Text
"mountFrontController" `isInfixOf`) [Text
"            , mountFrontController " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Application"]
    in
        case Maybe Text
withMaybeMountedFrontController of
            Just Text
result -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
result
            Maybe Text
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
needle Text
replacement Text
file)
                where
                    needle :: Text
needle =  Text
"    controllers = []"
                    replacement :: Text
replacement = Text
"    controllers = [\n            mountFrontController " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
applicationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Application" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n        ]"

-- | Gets content of a Types.hs, a existent data constructor and a type which should be added to it
--   and returns fileContent with the type in it.
addToDataConstructor :: Text -> Text -> Text -> Maybe Text
addToDataConstructor :: Text -> Text -> Text -> Maybe Text
addToDataConstructor Text
fileContent Text
dataConstructor Text
content = do
    Int
lineOfDataConstructor <- Text -> [Text]
lines Text
fileContent
        [Text] -> ([Text] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
        [(Int, Text)] -> ([(Int, Text)] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
n, Text
line) -> Text
dataConstructor Text -> Text -> Bool
`isInfixOf` Text
line)
        [(Int, Text)]
-> ([(Int, Text)] -> Maybe (Int, Text)) -> Maybe (Int, Text)
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [(Int, Text)] -> Maybe (Int, Text)
forall a. [a] -> Maybe a
lastMay
        Maybe (Int, Text) -> (Maybe (Int, Text) -> Maybe Int) -> Maybe Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Int) -> Maybe (Int, Text) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Text) -> Int
forall a b. (a, b) -> a
fst
    Int
lineOfDerivingStatement <- ((Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
lineOfDataConstructor ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
lines Text
fileContent) :: [Text])
        [Text] -> ([Text] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
lineOfDataConstructor..]
        [(Int, Text)] -> ([(Int, Text)] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
n, Text
line) -> Text
"deriving" Text -> Text -> Bool
`isInfixOf` Text
line)
        [(Int, Text)]
-> ([(Int, Text)] -> Maybe (Int, Text)) -> Maybe (Int, Text)
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [(Int, Text)] -> Maybe (Int, Text)
forall a. [a] -> Maybe a
headMay
        Maybe (Int, Text) -> (Maybe (Int, Text) -> Maybe Int) -> Maybe Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Int) -> Maybe (Int, Text) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Text) -> Int
forall a b. (a, b) -> a
fst
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
lineOfDerivingStatement ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
lines Text
fileContent) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
content] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
lineOfDerivingStatement ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
lines Text
fileContent))

appendLineAfter :: Text -> (Text -> Bool) -> [Text] -> Maybe Text
appendLineAfter :: Text -> (Text -> Bool) -> [Text] -> Maybe Text
appendLineAfter Text
file Text -> Bool
isRelevantLine [Text]
newLines =
    let [Text]
content :: [Text] = Text -> [Text]
lines Text
file
        lastImportLine :: Maybe Int
lastImportLine = [Text]
content
            [Text] -> ([Text] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
            [(Int, Text)] -> ([(Int, Text)] -> [(Int, Text)]) -> [(Int, Text)]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
n, Text
line) -> Text -> Bool
isRelevantLine Text
line)
            [(Int, Text)]
-> ([(Int, Text)] -> Maybe (Int, Text)) -> Maybe (Int, Text)
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [(Int, Text)] -> Maybe (Int, Text)
forall a. [a] -> Maybe a
lastMay
            Maybe (Int, Text) -> (Maybe (Int, Text) -> Maybe Int) -> Maybe Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> ((Int, Text) -> Int) -> Maybe (Int, Text) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Text) -> Int
forall a b. (a, b) -> a
fst
    in (Int -> Text) -> Maybe Int -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
lastImportLine -> [Text] -> Text
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
lastImportLine [Text]
content) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
newLines [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
lastImportLine [Text]
content)) Maybe Int
lastImportLine