{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module OpenAPI.Generate.IO where

import Control.Exception
import Control.Monad
import qualified Data.Bifunctor as BF
import qualified Data.Text as T
import Data.Version (showVersion)
import Language.Haskell.TH
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Embed
import OpenAPI.Generate.Internal.Util
import qualified OpenAPI.Generate.Log as OAL
import OpenAPI.Generate.Main
import qualified OpenAPI.Generate.Monad as OAM
import qualified OpenAPI.Generate.OptParse as OAO
import qualified OpenAPI.Generate.Reference as Ref
import qualified OpenAPI.Generate.Types as OAT
import Paths_openapi3_code_generator (version)
import System.Directory
import System.FilePath
import System.IO.Error

type FileWithContent = (FilePath, String)

type FilesWithContent = [FileWithContent]

srcDirectory :: FilePath
srcDirectory :: String
srcDirectory = String
"src"

-- | Creates files from mostly static data
cabalProjectFiles ::
  -- | Name of the cabal project
  String ->
  -- | Name of the module
  String ->
  -- | Modules to export
  [String] ->
  FilesWithContent
cabalProjectFiles :: String -> String -> [String] -> [(String, String)]
cabalProjectFiles String
packageName String
moduleName [String]
modulesToExport =
  [ ( String
packageName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cabal",
      [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        [ String
"cabal-version: 1.12",
          String
"",
          String
"name:           " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageName,
          String
"version:        0.1.0.0",
          String
"build-type:     Simple",
          String
"",
          String
"library",
          String
"  exposed-modules:",
          String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
moduleName
        ]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) [String]
modulesToExport
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [ String
"  hs-source-dirs:",
               String
"      src",
               String
"  build-depends:",
               String
"      base >=4.7 && <5",
               String
"    , text",
               String
"    , ghc-prim",
               String
"    , http-conduit",
               String
"    , http-client",
               String
"    , http-types",
               String
"    , bytestring",
               String
"    , aeson",
               String
"    , unordered-containers",
               String
"    , vector",
               String
"    , scientific",
               String
"    , time",
               String
"    , mtl",
               String
"    , transformers",
               String
"  default-language: Haskell2010"
             ]
    )
  ]

-- | Creates stack support files
stackProjectFiles ::
  FilesWithContent
stackProjectFiles :: [(String, String)]
stackProjectFiles =
  [ ( String
"stack.yaml",
      [String] -> String
unlines
        [ String
"resolver: lts-21.22",
          String
"packages:",
          String
"- ."
        ]
    )
  ]

-- | Creates nix support files
nixProjectFiles ::
  -- | Name of the cabal project
  String ->
  FilesWithContent
nixProjectFiles :: String -> [(String, String)]
nixProjectFiles String
packageName =
  [ ( String
"default.nix",
      [String] -> String
unlines
        [ String
"{ pkgs ? import <nixpkgs> {} }:",
          String
"let",
          String
"  src = pkgs.nix-gitignore.gitignoreSource [ ] ./.;",
          String
"in",
          String
"  pkgs.haskellPackages.callCabal2nix \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" ./. { }"
        ]
    ),
    ( String
"shell.nix",
      [String] -> String
unlines
        [ String
"{ pkgs ? import <nixpkgs> {} }:",
          String
"(import ./default.nix { inherit pkgs; }).env"
        ]
    )
  ]

replaceOpenAPI :: String -> String -> String
replaceOpenAPI :: String -> String -> String
replaceOpenAPI String
moduleName String
contents =
  Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"OpenAPI.Common" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
moduleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Common") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
      HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"OpenAPI.Configuration" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
moduleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Configuration") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
        String -> Text
T.pack String
contents

replaceVersionNumber :: String -> String
replaceVersionNumber :: String -> String
replaceVersionNumber String
contents =
  Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"VERSION_TO_REPLACE" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
      String -> Text
T.pack String
contents

permitProceed :: OAO.Settings -> IO Bool
permitProceed :: Settings -> IO Bool
permitProceed Settings
settings = do
  let outputDirectory :: String
outputDirectory = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Settings -> Text
OAO.settingOutputDir Settings
settings
  Bool
outputDirectoryExists <- String -> IO Bool
doesPathExist String
outputDirectory
  if Bool
outputDirectoryExists
    then
      if Settings -> Bool
OAO.settingForce Settings
settings Bool -> Bool -> Bool
|| Settings -> Bool
OAO.settingIncremental Settings
settings
        then do
          String -> IO ()
putStrLn String
"Output directory already exists and will be overwritten"
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        else do
          String -> IO ()
putStrLn String
"The output directory "
          String -> IO ()
putStrLn String
""
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
outputDirectory
          String -> IO ()
putStrLn String
""
          String -> IO ()
putStrLn String
"already exists. overwrite? Y/N"
          String -> IO ()
putStrLn String
""
          String
answer <- IO String
getLine
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (String
answer String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Y") Bool -> Bool -> Bool
|| (String
answer String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"y")
    else do
      String -> IO ()
putStrLn String
"Output directory will be created"
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

getHsBootFiles :: OAO.Settings -> [([String], String)] -> FilesWithContent
getHsBootFiles :: Settings -> [([String], String)] -> [(String, String)]
getHsBootFiles Settings
settings [([String], String)]
modelModules =
  let outputDirectory :: String
outputDirectory = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Settings -> Text
OAO.settingOutputDir Settings
settings
      moduleName :: ModuleName
moduleName = Settings -> ModuleName
OAO.settingModuleName Settings
settings
      moduleNameStr :: String
moduleNameStr = ModuleName -> String
OAO.getModuleName ModuleName
moduleName
      modulePathInfo :: ModulePathInfo
modulePathInfo = ModuleName -> ModulePathInfo
OAO.mkModulePathInfo ModuleName
moduleName
   in ([String] -> String)
-> (String -> String) -> ([String], String) -> (String, String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap
        ((\String
suffix -> String
outputDirectory String -> String -> String
</> String
srcDirectory String -> String -> String
</> ModulePathInfo -> Maybe String -> String -> String
OAO.getModuleInfoPath ModulePathInfo
modulePathInfo (String -> Maybe String
forall a. a -> Maybe a
Just String
suffix) String
".hs-boot") (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> String -> String
(</>))
        ( Text -> String
T.unpack
            (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
            ([Text] -> Text) -> (String -> [Text]) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \[Text]
xs -> case [Text]
xs of
                  Text
x : [Text]
xs' ->
                    Text
x
                      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"import qualified Data.Aeson"
                      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"import qualified " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
moduleNameStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Common"
                      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs'
                  [Text]
_ -> [Text]
xs
              )
            ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( ( \Text
l ->
                    [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                      [Text
l]
                      ( \Text
suffix ->
                          [ Text
l,
                            Text
"instance Show" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix,
                            Text
"instance Eq" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix,
                            Text
"instance Data.Aeson.FromJSON" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix,
                            Text
"instance Data.Aeson.ToJSON" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
                          ]
                      )
                      (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"data" Text
l
                )
                  (Text -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ( (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
l -> if Text -> Text -> Bool
T.isPrefixOf Text
"type" Text
l then Text
l else Text -> Text
T.strip ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') Text
l))
                          ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
line -> Text -> Text -> Bool
T.isPrefixOf Text
"data" Text
line Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"module" Text
line Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"type" Text
line)
                          ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
                          (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                      )
              )
        )
        (([String], String) -> (String, String))
-> [([String], String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([String], String) -> Bool)
-> [([String], String)] -> [([String], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          ( \([String]
p, String
_) -> case [String]
p of
              String
"Types" : String
_ : [String]
_ -> Bool
True
              [String]
_ -> Bool
False
          )
          [([String], String)]
modelModules

data OutputFiles = OutputFiles
  { OutputFiles -> [(String, String)]
outputFilesModuleFiles :: FilesWithContent,
    OutputFiles -> [(String, String)]
outputFilesCabalFiles :: FilesWithContent,
    OutputFiles -> [(String, String)]
outputFilesStackFiles :: FilesWithContent,
    OutputFiles -> [(String, String)]
outputFilesNixFiles :: FilesWithContent
  }

generateFilesToCreate :: OAT.OpenApiSpecification -> OAO.Settings -> IO OutputFiles
generateFilesToCreate :: OpenApiSpecification -> Settings -> IO OutputFiles
generateFilesToCreate OpenApiSpecification
spec Settings
settings = do
  let outputDirectory :: String
outputDirectory = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Settings -> Text
OAO.settingOutputDir Settings
settings
      moduleName :: ModuleName
moduleName = Settings -> ModuleName
OAO.settingModuleName Settings
settings
      modulePathInfo :: ModulePathInfo
modulePathInfo = ModuleName -> ModulePathInfo
OAO.mkModulePathInfo ModuleName
moduleName
      moduleNameStr :: String
moduleNameStr = ModuleName -> String
OAO.getModuleName ModuleName
moduleName
      packageName :: String
packageName = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Settings -> Text
OAO.settingPackageName Settings
settings
      env :: GeneratorEnvironment
env = Settings -> ReferenceMap -> GeneratorEnvironment
OAM.createEnvironment Settings
settings (ReferenceMap -> GeneratorEnvironment)
-> ReferenceMap -> GeneratorEnvironment
forall a b. (a -> b) -> a -> b
$ OpenApiSpecification -> ReferenceMap
Ref.buildReferenceMap OpenApiSpecification
spec
      logMessages :: LogEntries -> IO ()
logMessages = (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> IO ()) -> (LogEntries -> [Text]) -> LogEntries -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSeverity -> LogEntries -> [Text]
OAL.filterAndTransformLogs (Settings -> LogSeverity
OAO.settingLogLevel Settings
settings)
      showAndReplace :: Doc -> String
showAndReplace = String -> String -> String
replaceOpenAPI String
moduleNameStr (String -> String) -> (Doc -> String) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show
      ((Q [ModuleDefinition]
operationsQ, Models
operationDependencies), LogEntries
logs) = GeneratorEnvironment
-> Generator (Q [ModuleDefinition], Models)
-> ((Q [ModuleDefinition], Models), LogEntries)
forall a. GeneratorEnvironment -> Generator a -> (a, LogEntries)
OAM.runGenerator GeneratorEnvironment
env (Generator (Q [ModuleDefinition], Models)
 -> ((Q [ModuleDefinition], Models), LogEntries))
-> Generator (Q [ModuleDefinition], Models)
-> ((Q [ModuleDefinition], Models), LogEntries)
forall a b. (a -> b) -> a -> b
$ String
-> OpenApiSpecification -> Generator (Q [ModuleDefinition], Models)
defineOperations String
moduleNameStr OpenApiSpecification
spec
  LogEntries -> IO ()
logMessages LogEntries
logs
  [ModuleDefinition]
operationModules <- Q [ModuleDefinition] -> IO [ModuleDefinition]
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ Q [ModuleDefinition]
operationsQ
  Doc
configurationInfo <- Q Doc -> IO Doc
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ (Q Doc -> IO Doc) -> Q Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ String -> OpenApiSpecification -> Q Doc
defineConfigurationInformation String
moduleNameStr OpenApiSpecification
spec
  let (Q [ModuleDefinition]
modelsQ, LogEntries
logsModels) = GeneratorEnvironment
-> Generator (Q [ModuleDefinition])
-> (Q [ModuleDefinition], LogEntries)
forall a. GeneratorEnvironment -> Generator a -> (a, LogEntries)
OAM.runGenerator GeneratorEnvironment
env (Generator (Q [ModuleDefinition])
 -> (Q [ModuleDefinition], LogEntries))
-> Generator (Q [ModuleDefinition])
-> (Q [ModuleDefinition], LogEntries)
forall a b. (a -> b) -> a -> b
$ String
-> OpenApiSpecification
-> Models
-> Generator (Q [ModuleDefinition])
defineModels String
moduleNameStr OpenApiSpecification
spec Models
operationDependencies
  LogEntries -> IO ()
logMessages LogEntries
logsModels
  [([String], String)]
modelModules <- (ModuleDefinition -> ([String], String))
-> [ModuleDefinition] -> [([String], String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc -> String) -> ModuleDefinition -> ([String], String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second Doc -> String
showAndReplace) ([ModuleDefinition] -> [([String], String)])
-> IO [ModuleDefinition] -> IO [([String], String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q [ModuleDefinition] -> IO [ModuleDefinition]
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ Q [ModuleDefinition]
modelsQ
  let (Q Doc
securitySchemesQ, LogEntries
logs') = GeneratorEnvironment -> Generator (Q Doc) -> (Q Doc, LogEntries)
forall a. GeneratorEnvironment -> Generator a -> (a, LogEntries)
OAM.runGenerator GeneratorEnvironment
env (Generator (Q Doc) -> (Q Doc, LogEntries))
-> Generator (Q Doc) -> (Q Doc, LogEntries)
forall a b. (a -> b) -> a -> b
$ String -> OpenApiSpecification -> Generator (Q Doc)
defineSecuritySchemes String
moduleNameStr OpenApiSpecification
spec
  LogEntries -> IO ()
logMessages LogEntries
logs'
  Doc
securitySchemes' <- Q Doc -> IO Doc
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ Q Doc
securitySchemesQ
  let modules :: [([String], String)]
modules =
        (ModuleDefinition -> ([String], String))
-> [ModuleDefinition] -> [([String], String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [String])
-> (Doc -> String) -> ModuleDefinition -> ([String], String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap (String
"Operations" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) Doc -> String
showAndReplace) [ModuleDefinition]
operationModules
          [([String], String)]
-> [([String], String)] -> [([String], String)]
forall a. Semigroup a => a -> a -> a
<> [([String], String)]
modelModules
          [([String], String)]
-> [([String], String)] -> [([String], String)]
forall a. Semigroup a => a -> a -> a
<> [ ([String
"Configuration"], Doc -> String
showAndReplace Doc
configurationInfo),
               ([String
"SecuritySchemes"], Doc -> String
showAndReplace Doc
securitySchemes'),
               ([String
"Common"], String -> String -> String
replaceOpenAPI String
moduleNameStr (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
replaceVersionNumber $(embedFile "src/OpenAPI/Common.hs"))
             ]
      modulesToExport :: [String]
modulesToExport =
        (([String], String) -> String) -> [([String], String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( (String
moduleNameStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
              (String -> String)
-> (([String], String) -> String) -> ([String], String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
              (String -> String)
-> (([String], String) -> String) -> ([String], String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
joinWithPoint
              ([String] -> String)
-> (([String], String) -> [String]) -> ([String], String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], String) -> [String]
forall a b. (a, b) -> a
fst
          )
          [([String], String)]
modules
      mainFile :: String
mainFile = String
outputDirectory String -> String -> String
</> String
srcDirectory String -> String -> String
</> ModulePathInfo -> Maybe String -> String -> String
OAO.getModuleInfoPath ModulePathInfo
modulePathInfo Maybe String
forall a. Maybe a
Nothing String
".hs"
      mainModuleContent :: String
mainModuleContent = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> Doc
Doc.createModuleHeaderWithReexports String
moduleNameStr [String]
modulesToExport String
"The main module which exports all functionality."
      hsBootFiles :: [(String, String)]
hsBootFiles = Settings -> [([String], String)] -> [(String, String)]
getHsBootFiles Settings
settings [([String], String)]
modelModules
  OutputFiles -> IO OutputFiles
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OutputFiles -> IO OutputFiles) -> OutputFiles -> IO OutputFiles
forall a b. (a -> b) -> a -> b
$
    [(String, String)]
-> [(String, String)]
-> [(String, String)]
-> [(String, String)]
-> OutputFiles
OutputFiles
      ( (String -> String) -> (String, String) -> (String, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines)
          ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
mainFile, String
mainModuleContent)
            (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: (([String] -> String) -> ([String], String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first ((\String
suffix -> String
outputDirectory String -> String -> String
</> String
srcDirectory String -> String -> String
</> ModulePathInfo -> Maybe String -> String -> String
OAO.getModuleInfoPath ModulePathInfo
modulePathInfo (String -> Maybe String
forall a. a -> Maybe a
Just String
suffix) String
".hs") (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> String -> String
(</>)) (([String], String) -> (String, String))
-> [([String], String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([String], String)]
modules)
              [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> [(String, String)]
hsBootFiles
      )
      ((String -> String) -> (String, String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first (String
outputDirectory String -> String -> String
</>) ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String] -> [(String, String)]
cabalProjectFiles String
packageName String
moduleNameStr [String]
modulesToExport)
      ((String -> String) -> (String, String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first (String
outputDirectory String -> String -> String
</>) ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
stackProjectFiles)
      ((String -> String) -> (String, String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first (String
outputDirectory String -> String -> String
</>) ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)]
nixProjectFiles String
packageName)

writeFiles :: OAO.Settings -> OutputFiles -> IO ()
writeFiles :: Settings -> OutputFiles -> IO ()
writeFiles Settings
settings OutputFiles {[(String, String)]
outputFilesModuleFiles :: OutputFiles -> [(String, String)]
outputFilesCabalFiles :: OutputFiles -> [(String, String)]
outputFilesStackFiles :: OutputFiles -> [(String, String)]
outputFilesNixFiles :: OutputFiles -> [(String, String)]
outputFilesModuleFiles :: [(String, String)]
outputFilesCabalFiles :: [(String, String)]
outputFilesStackFiles :: [(String, String)]
outputFilesNixFiles :: [(String, String)]
..} = do
  let outputDirectory :: String
outputDirectory = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Settings -> Text
OAO.settingOutputDir Settings
settings
      modulePathInfo :: ModulePathInfo
modulePathInfo = ModuleName -> ModulePathInfo
OAO.mkModulePathInfo (ModuleName -> ModulePathInfo) -> ModuleName -> ModulePathInfo
forall a b. (a -> b) -> a -> b
$ Settings -> ModuleName
OAO.settingModuleName Settings
settings
      moduleDir :: String
moduleDir = ModulePathInfo -> String
OAO.getModuleInfoDir ModulePathInfo
modulePathInfo
      incremental :: Bool
incremental = Settings -> Bool
OAO.settingIncremental Settings
settings
      write :: [(String, String)] -> IO ()
write = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((String, String) -> IO ()) -> [(String, String)] -> IO ())
-> ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
incremental then (String, String) -> IO ()
writeFileIncremental else (String, String) -> IO ()
writeFileWithLog
  String -> IO ()
putStrLn String
"Remove old output directory"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
incremental (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IO (Either IOException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either IOException ()) -> IO ())
-> IO (Either IOException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIOError (String -> IO ()
removeDirectoryRecursive String
outputDirectory)
  String -> IO ()
putStrLn String
"Output directory removed, create missing directories"
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
outputDirectory String -> String -> String
</> String
srcDirectory String -> String -> String
</> String
moduleDir String -> String -> String
</> String
"Operations")
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
outputDirectory String -> String -> String
</> String
srcDirectory String -> String -> String
</> String
moduleDir String -> String -> String
</> String
"Types")
  String -> IO ()
putStrLn String
"Directories created"
  [(String, String)] -> IO ()
write [(String, String)]
outputFilesModuleFiles
  [(String, String)] -> IO ()
write [(String, String)]
outputFilesCabalFiles
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Settings -> Bool
OAO.settingDoNotGenerateStackProject Settings
settings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [(String, String)] -> IO ()
write [(String, String)]
outputFilesStackFiles
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
OAO.settingGenerateNixFiles Settings
settings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [(String, String)] -> IO ()
write [(String, String)]
outputFilesNixFiles

writeFileWithLog :: FileWithContent -> IO ()
writeFileWithLog :: (String, String) -> IO ()
writeFileWithLog (String
filePath, String
content) = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Write file to path: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath
  String -> String -> IO ()
writeFile String
filePath String
content

writeFileIncremental :: FileWithContent -> IO ()
writeFileIncremental :: (String, String) -> IO ()
writeFileIncremental (String
filePath, String
content) = do
  Maybe String
oldContent <-
    (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
filePath)
      IO (Maybe String)
-> (IOException -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` ( \(IOException
_ :: IOException) -> do
                  String -> String -> IO ()
writeFile String
filePath String
content
                  Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
              )
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> (String -> Int) -> Maybe String -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe String
oldContent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Maybe String
oldContent Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
content) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> String -> IO ()
writeFile String
filePath String
content