{-# LANGUAGE QuasiQuotes #-}

{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Templates for generated Haskell source code files.
-}

module Summoner.Template.Haskell
       ( haskellFiles
       ) where

import NeatInterpolation (text)

import Summoner.Settings (Settings (..))
import Summoner.Text (packageToModule)
import Summoner.Tree (TreeFs (..))


haskellFiles :: Settings -> [TreeFs]
haskellFiles :: Settings -> [TreeFs]
haskellFiles Settings{..} = [[TreeFs]] -> [TreeFs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ FilePath -> [TreeFs] -> TreeFs
Dir "src"       [TreeFs
libFile]       | Bool
settingsIsLib ]
    , [ FilePath -> [TreeFs] -> TreeFs
Dir "app"       [TreeFs
exeFile]       | Bool
settingsIsExe ]
    , [ FilePath -> [TreeFs] -> TreeFs
Dir "test"      [TreeFs
testFile]      | Bool
settingsTest  ]
    , [ FilePath -> [TreeFs] -> TreeFs
Dir "benchmark" [TreeFs
benchmarkFile] | Bool
settingsBench ]
    ]
  where
    libFile :: TreeFs
    libFile :: TreeFs
libFile = FilePath -> Text -> TreeFs
File (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
libModuleName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ".hs")
        [text|
        {- |
        Copyright: (c) $settingsYear $settingsFullName
        SPDX-License-Identifier: $licenseName
        Maintainer: $settingsFullName <$settingsEmail>

        $settingsDescription
        -}

        module $libModuleName
               ( someFunc
               ) where


        someFunc :: IO ()
        someFunc = putStrLn ("someFunc" :: String)
        |]

    libModuleName :: Text
    libModuleName :: Text
libModuleName = Text -> Text
packageToModule Text
settingsRepo

    licenseName :: Text
    licenseName :: Text
licenseName = LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show LicenseName
settingsLicenseName

    exeFile :: TreeFs
    exeFile :: TreeFs
exeFile = FilePath -> Text -> TreeFs
File "Main.hs" (Text -> TreeFs) -> Text -> TreeFs
forall a b. (a -> b) -> a -> b
$ if Bool
settingsIsLib then Text
createExe else Text
createOnlyExe

    createOnlyExe :: Text
    createOnlyExe :: Text
createOnlyExe =
        [text|
        module Main (main) where


        main :: IO ()
        main = putStrLn ("Hello, world!" :: String)
        |]

    createExe :: Text
    createExe :: Text
createExe =
        [text|
        module Main (main) where

        import $libModuleName (someFunc)


        main :: IO ()
        main = someFunc
        |]

    testFile :: TreeFs
    testFile :: TreeFs
testFile = FilePath -> Text -> TreeFs
File "Spec.hs"
        [text|
        module Main (main) where


        main :: IO ()
        main = putStrLn ("Test suite is not implemented" :: String)
        |]

    benchmarkFile :: TreeFs
    benchmarkFile :: TreeFs
benchmarkFile = FilePath -> Text -> TreeFs
File "Main.hs"
        [text|
        module Main (main) where

        import Gauge.Main


        main :: IO ()
        main = defaultMain [bench "const" (whnf const ())]
        |]