{-# LANGUAGE QuasiQuotes #-}

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

@.cabal@ file template.
-}

module Summoner.Template.Cabal
       ( cabalFile
       ) where

import NeatInterpolation (text)

import Summoner.CustomPrelude (CustomPrelude (..))
import Summoner.Default (defaultCabal)
import Summoner.GhcVer (cabalBaseVersions, showGhcVer)
import Summoner.License (LicenseName (..))
import Summoner.Settings (Settings (..))
import Summoner.Text (endLine, intercalateMap, packageToModule)
import Summoner.Tree (TreeFs (..))

import qualified Data.Text as T


-- | Creates a `.cabal` file from the given 'Settings'.
cabalFile :: Settings -> TreeFs
cabalFile :: Settings -> TreeFs
cabalFile Settings{..} = FilePath -> Text -> TreeFs
File (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
settingsRepo FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ".cabal") Text
cabalFileContent
  where
    cabalFileContent :: Text
    cabalFileContent :: Text
cabalFileContent = [Text] -> Text
T.concat
        [ Text
cabalHeader
        , Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsGitHub Text
sourceRepository
        , Text
commonStanza
        , Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsIsLib Text
libraryStanza
        , Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsIsExe Text
executableStanza
        , Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsTest  Text
testSuiteStanza
        , Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsBench (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
benchmarkStanza (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsIsLib (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsRepo
        ]

    -- TODO: do something to not have empty lines
    cabalHeader :: Text
    cabalHeader :: Text
cabalHeader = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        [ "cabal-version:       " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
defaultCabal
        , "name:                " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsRepo
        , "version:             0.0.0.0"
        , "synopsis:            " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsDescription
        , "description:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsDescription ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ "homepage:            " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
githubUrl        | Bool
settingsGitHub ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ "bug-reports:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
githubBugReports | Bool
settingsGitHub ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        ( "license:             " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
licenseName) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
        [ "license-file:        LICENSE" | LicenseName
settingsLicenseName LicenseName -> LicenseName -> Bool
forall a. Eq a => a -> a -> Bool
/= LicenseName
NONE] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ "author:              " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsFullName
        , "maintainer:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsFullName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " <" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsEmail Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"
        , "copyright:           " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsYear Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsFullName ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ "category:            " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsCategories | "" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
settingsCategories ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ "build-type:          Simple"
        , "extra-doc-files:     README.md"
        , "                     CHANGELOG.md"
        , "tested-with:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testedGhcs
        ]

    githubUrl, githubBugReports :: Text
    githubUrl :: Text
githubUrl        = "https://github.com/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsOwner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsRepo
    githubBugReports :: Text
githubBugReports = Text
githubUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/issues"

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

    testedGhcs :: Text
    testedGhcs :: Text
testedGhcs = Text -> (GhcVer -> Text) -> [GhcVer] -> Text
forall a. Text -> (a -> Text) -> [a] -> Text
intercalateMap
        ("\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate 21 " ")
        (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend "GHC == " (Text -> Text) -> (GhcVer -> Text) -> GhcVer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcVer -> Text
showGhcVer)
        [GhcVer]
settingsTestedVersions

    sourceRepository :: Text
    sourceRepository :: Text
sourceRepository =
        [text|
        $endLine
        source-repository head
          type:                git
          location:            ${githubUrl}.git
        |]

    commonStanza :: Text
    commonStanza :: Text
commonStanza =
        [text|
        $endLine
        common common-options
          build-depends:       base $baseBounds
          $customPrelude
          $ghcOptions

          default-language:    Haskell2010
    |] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
defaultExtensions

    baseBounds :: Text
    baseBounds :: Text
baseBounds = [GhcVer] -> Text
cabalBaseVersions [GhcVer]
settingsTestedVersions

    ghcOptions :: Text
    ghcOptions :: Text
ghcOptions = case [Text]
settingsGhcOptions of
        [] -> Text
defaultGhcOptions
        x :: Text
x:xs :: [Text]
xs ->
            let customGhcOptions :: Text
customGhcOptions = Text -> [Text] -> Text
T.intercalate "\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.replicate 21 " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
xs in
            [text|
            ghc-options:         $customGhcOptions
            |]

    defaultGhcOptions :: Text
    defaultGhcOptions :: Text
defaultGhcOptions =
        [text|
        ghc-options:         -Wall
                             -Wcompat
                             -Widentities
                             -Wincomplete-uni-patterns
                             -Wincomplete-record-updates
        if impl(ghc >= 8.0)
          ghc-options:       -Wredundant-constraints
        if impl(ghc >= 8.2)
          ghc-options:       -fhide-source-paths
        if impl(ghc >= 8.4)
          ghc-options:       -Wmissing-export-lists
                             -Wpartial-fields
        if impl(ghc >= 8.8)
          ghc-options:       -Wmissing-deriving-strategies
        |]

    libraryStanza :: Text
    libraryStanza :: Text
libraryStanza =
        [text|
        $endLine
        library
          import:              common-options
          hs-source-dirs:      src
          exposed-modules:     $libModuleName
        |]

    executableStanza :: Text
    executableStanza :: Text
executableStanza =
        [text|
        $endLine
        executable $settingsRepo
          import:              common-options
          hs-source-dirs:      app
          main-is:             Main.hs
          $buildDepends
          $rtsOptions
        |]

    testSuiteStanza :: Text
    testSuiteStanza :: Text
testSuiteStanza =
        [text|
        $endLine
        test-suite ${settingsRepo}-test
          import:              common-options
          type:                exitcode-stdio-1.0
          hs-source-dirs:      test
          main-is:             Spec.hs
          $buildDepends
          $rtsOptions
        |]

    benchmarkStanza :: Text -> Text
    benchmarkStanza :: Text -> Text
benchmarkStanza commaRepo :: Text
commaRepo =
        [text|
        $endLine
        benchmark ${settingsRepo}-benchmark
          import:              common-options
          type:                exitcode-stdio-1.0
          hs-source-dirs:      benchmark
          main-is:             Main.hs
          build-depends:       gauge
                             $commaRepo
          $rtsOptions
          |]

    -- | @build-depends@ for the repo, only if the library is on.
    buildDepends :: Text
    buildDepends :: Text
buildDepends =
        if Bool
settingsIsLib
        then "build-depends:       " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsRepo
        else ""

    rtsOptions :: Text
    rtsOptions :: Text
rtsOptions =
        [text|
        ghc-options:         -threaded
                             -rtsopts
                             -with-rtsopts=-N
        |]

    customPrelude :: Text
    customPrelude :: Text
customPrelude = case Maybe CustomPrelude
settingsPrelude of
        Nothing -> ""
        Just CustomPrelude{..} ->
            "                   , " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cpPackage Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            [text|
            $endLine
            mixins:              base hiding (Prelude)
                               , $cpPackage ($cpModule as Prelude)
            $endLine
            |]

    defaultExtensions :: Text
    defaultExtensions :: Text
defaultExtensions = case [Text]
settingsExtensions of
        [] -> ""
        xs :: [Text]
xs -> "  default-extensions:  "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "\n                       " [Text]
xs
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"