module ServantSerf.Module where

import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified ServantSerf.Type.Config as Config
import qualified ServantSerf.Type.Context as Context
import qualified ServantSerf.Type.ModuleName as ModuleName
import qualified System.FilePath as FilePath

generate :: Context.Context -> [FilePath] -> String
generate :: Context -> [FilePath] -> FilePath
generate Context
context [FilePath]
files =
  let
    source :: FilePath
source = Context -> FilePath
Context.source Context
context
    config :: Config
config = Context -> Config
Context.config Context
context
    apiName :: FilePath
apiName = Config -> FilePath
Config.apiName Config
config
    serverName :: FilePath
serverName = Config -> FilePath
Config.serverName Config
config
    moduleName :: FilePath
moduleName = case Config -> Maybe ModuleName
Config.moduleName Config
config of
      Maybe ModuleName
Nothing ->
        FilePath
-> (ModuleName -> FilePath) -> Maybe ModuleName -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"Main" ModuleName -> FilePath
ModuleName.toString
          (Maybe ModuleName -> FilePath)
-> (FilePath -> Maybe ModuleName) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe ModuleName
ModuleName.fromFilePath
          (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Context -> FilePath
Context.source Context
context
      Just ModuleName
x -> ModuleName -> FilePath
ModuleName.toString ModuleName
x
    moduleNames :: [FilePath]
moduleNames =
      (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> FilePath
ModuleName.toString
        ([ModuleName] -> [FilePath])
-> ([FilePath] -> [ModuleName]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
List.sort
        ([ModuleName] -> [ModuleName])
-> ([FilePath] -> [ModuleName]) -> [FilePath] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe FilePath -> Maybe ModuleName
ModuleName.fromFilePath
        ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
FilePath.isExtensionOf FilePath
"hs") [FilePath]
files
  in [FilePath] -> FilePath
unlines
    [ FilePath
"{-# LINE 1 " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
source FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" #-}"
    , FilePath
"{-# OPTIONS_GHC -w #-}"
    , FilePath
""
    , FilePath
"module " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
moduleName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" where"
    , FilePath
""
    , FilePath
"import qualified Servant"
    , FilePath
""
    , FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
"import qualified " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) [FilePath]
moduleNames
    , FilePath
""
    , FilePath
"type " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
apiName
    , FilePath
"\t= " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
moduleNames
      then FilePath
"Servant.EmptyAPI"
      else FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n\tServant.:<|> "
        ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
apiName) [FilePath]
moduleNames
    , FilePath
""
    , FilePath
serverName
    , FilePath
"\t= " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
moduleNames
      then FilePath
"Servant.emptyServer"
      else FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n\tServant.:<|> "
        ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
serverName) [FilePath]
moduleNames
    ]