{-# LANGUAGE QuasiQuotes  #-}
{-# LANGUAGE ViewPatterns #-}

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

This module contains template for GitHub related docs:

 * @.gitignore@ — static file with all Haskell related ignored files.
 * @.github/workflows/ci.yml@ — GitHub acttions for Cabal projects.
 * @appveyor.yml@ — Appveyor CI for Cabal or Stack projects.
 * @.travis.yml@ — depending on the build tool and supported GHC versions
   builds the Travis matrix with all necessary checks, including HLint check.
   __NOTE:__ Old GHC versions are included into @allow_failure@ Travis matrix
   section for Stack due to Stack limitations with the Cabal version usage on
   each GHC. See this issue to track the problem:

    + https://github.com/commercialhaskell/stack/issues/4488
-}

module Summoner.Template.GitHub
       ( gitHubFiles
       ) where

import Data.List (delete, intersect)
import NeatInterpolation (text)

import Summoner.Default (defaultCabal, defaultGHC)
import Summoner.GhcVer (GhcVer (..), oldGhcs, showGhcVer)
import Summoner.Settings (Settings (..))
import Summoner.Text (endLine, intercalateMap, tconcatMap)
import Summoner.Tree (TreeFs (..))


gitHubFiles :: Settings -> [TreeFs]
gitHubFiles :: Settings -> [TreeFs]
gitHubFiles Settings{..} = [[TreeFs]] -> [TreeFs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [FilePath -> Text -> TreeFs
File ".gitignore" (Text
gitignoreDefault Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gitignoreCustom) | Bool
settingsGitHub]
    , [FilePath -> [TreeFs] -> TreeFs
Dir ".github" [ FilePath -> [TreeFs] -> TreeFs
Dir "workflows" [ FilePath -> Text -> TreeFs
File "ci.yml" Text
ghActionsYml ]] | Bool
settingsGhActions ]
    , [FilePath -> Text -> TreeFs
File ".travis.yml" Text
travisYml    | Bool
settingsTravis]
    , [FilePath -> Text -> TreeFs
File "appveyor.yml" Text
appVeyorYml | Bool
settingsAppVeyor]
    ]
  where
    -- default .gitignore template
    gitignoreDefault :: Text
    gitignoreDefault :: Text
gitignoreDefault =
        [text|
        ### Haskell
        dist
        dist-*
        cabal-dev
        *.o
        *.hi
        *.chi
        *.chs.h
        *.dyn_o
        *.dyn_hi
        *.prof
        *.aux
        *.hp
        *.eventlog
        .virtualenv
        .hsenv
        .hpc
        .cabal-sandbox/
        cabal.sandbox.config
        cabal.config
        cabal.project.local
        .ghc.environment.*
        .HTF/
        # Stack
        .stack-work/
        stack.yaml.lock

        ### IDE/support
        # Vim
        [._]*.s[a-v][a-z]
        [._]*.sw[a-p]
        [._]s[a-v][a-z]
        [._]sw[a-p]
        *~
        tags

        # IntellijIDEA
        .idea/
        .ideaHaskellLib/
        *.iml

        # Atom
        .haskell-ghc-mod.json

        # VS
        .vscode/

        # Emacs
        *#
        .dir-locals.el
        TAGS

        # other
        .DS_Store
        |]

    -- additional .gitignore
    gitignoreCustom :: Text
    gitignoreCustom :: Text
gitignoreCustom = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
settingsGitignore
        then ""
        else [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ("\n# User specific" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
settingsGitignore)

    ghActionsYml :: Text
    ghActionsYml :: Text
ghActionsYml = [text|
        name: CI

        # Trigger the workflow on push or pull request, but only for the master branch
        on:
          pull_request:
          push:
            branches: [master]

        jobs:
          build:
            name: ghc ${{ matrix.ghc }}
            runs-on: ubuntu-16.04
            strategy:
              matrix:
                cabal: ["${defaultCabal}"]
                ghc:
                  ${ghActionsVersions}

            steps:
            - uses: actions/checkout@v2
              if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'

            - uses: actions/setup-haskell@v1
              name: Setup Haskell
              with:
                ghc-version: ${{ matrix.ghc }}
                cabal-version: ${{ matrix.cabal }}

            - uses: actions/cache@v1
              name: Cache ~/.cabal/store
              with:
                path: ~/.cabal/store
                key: ${{ runner.os }}-${{ matrix.ghc }}-cabal

            - name: Build
              run: |
                $cabalUpdate
                $cabalBuild

            - name: Test
              run: |
                ${cabalTest}
        |]


    ghActionsVersions :: Text
    ghActionsVersions :: Text
ghActionsVersions = Text -> (GhcVer -> Text) -> [GhcVer] -> Text
forall a. Text -> (a -> Text) -> [a] -> Text
intercalateMap
        "\n"
        (\ghc :: GhcVer
ghc -> "- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GhcVer -> Text
ghActionsMatrixItem GhcVer
ghc)
        [GhcVer]
settingsTestedVersions

    ghActionsMatrixItem :: GhcVer -> Text
    ghActionsMatrixItem :: GhcVer -> Text
ghActionsMatrixItem v :: GhcVer
v = "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GhcVer -> Text
showGhcVer GhcVer
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""

    -- create travis.yml template
    travisYml :: Text
    travisYml :: Text
travisYml =
        [text|
        sudo: true
        language: haskell

        git:
          depth: 5

        cabal: "${defaultCabal}"

        cache:
          directories:
          $travisCabalCache
          $travisStackCache

        matrix:
          include:
          $travisCabalMtr
          $travisStackMtr
          $travisStackAllowFailuresMtr

        $installAndScript

        notifications:
          email: false
        |]

    travisCabalCache, travisStackCache :: Text
    travisCabalCache :: Text
travisCabalCache = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsCabal "- \"$HOME/.cabal/store\""
    travisStackCache :: Text
travisStackCache = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsStack
        [text|
        - "$$HOME/.stack"
        - "$$TRAVIS_BUILD_DIR/.stack-work"
        |]

    travisCabalMtr :: Text
    travisCabalMtr :: Text
travisCabalMtr = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsCabal (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
        (GhcVer -> Text) -> [GhcVer] -> Text
forall a. (a -> Text) -> [a] -> Text
tconcatMap GhcVer -> Text
travisCabalMatrixItem [GhcVer]
settingsTestedVersions

    travisCabalMatrixItem :: GhcVer -> Text
    travisCabalMatrixItem :: GhcVer -> Text
travisCabalMatrixItem (GhcVer -> Text
showGhcVer -> Text
ghcV) = [text|- ghc: $ghcV|]

    -- Due to the Stack issues with newer Cabal versions TravisCI for 'oldGhcs'
    -- can fail. Possible failure jobs are added to the @allow-failures@ section.
    travisStackMtr :: Text
    travisStackMtr :: Text
travisStackMtr = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsStack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (GhcVer -> Text) -> [GhcVer] -> Text
forall a. (a -> Text) -> [a] -> Text
tconcatMap
           GhcVer -> Text
travisStackMatrixItem (GhcVer -> [GhcVer] -> [GhcVer]
forall a. Eq a => a -> [a] -> [a]
delete GhcVer
defaultGHC [GhcVer]
settingsTestedVersions)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
travisStackMatrixDefaultItem

    travisStackAllowFailuresMtr :: Text
    travisStackAllowFailuresMtr :: Text
travisStackAllowFailuresMtr = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse (Bool
settingsStack Bool -> Bool -> Bool
&& Bool -> Bool
not ([GhcVer] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GhcVer]
old))
        [text|
        $endLine
        allow_failures:
        $matrix
        |]
      where
        old :: [GhcVer]
        old :: [GhcVer]
old = [GhcVer]
settingsTestedVersions [GhcVer] -> [GhcVer] -> [GhcVer]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [GhcVer]
oldGhcs

        matrix :: Text
        matrix :: Text
matrix = (GhcVer -> Text) -> [GhcVer] -> Text
forall a. (a -> Text) -> [a] -> Text
tconcatMap GhcVer -> Text
travisStackMatrixItem [GhcVer]
old

    travisStackMatrixItem :: GhcVer -> Text
    travisStackMatrixItem :: GhcVer -> Text
travisStackMatrixItem (GhcVer -> Text
showGhcVer -> Text
ghcV) =
        [text|
        $endLine
        - ghc: ${ghcV}
          env: STACK_YAML="$$TRAVIS_BUILD_DIR/stack-$ghcV.yaml"
        |]

    travisStackMatrixDefaultItem :: Text
    travisStackMatrixDefaultItem :: Text
travisStackMatrixDefaultItem = let defGhc :: Text
defGhc = GhcVer -> Text
showGhcVer GhcVer
defaultGHC in
        [text|
        $endLine
        - ghc: ${defGhc}
          env: STACK_YAML="$$TRAVIS_BUILD_DIR/stack.yaml"
        |]

    installAndScript :: Text
    installAndScript :: Text
installAndScript =
        if Bool
settingsCabal
        then if Bool
settingsStack
             then Text
installScriptBoth
             else Text
installScriptCabal
        else Text
installScriptStack

    installScriptBoth :: Text
    installScriptBoth :: Text
installScriptBoth =
        [text|
        install:
          $hlintCheck

          - |
            if [ -z "$$STACK_YAML" ]; then
              $cabalUpdate
              $cabalBuild
            else
              curl -sSL https://get.haskellstack.org/ | sh
              stack --version
              $stackBuild
            fi

        script:
          - |
            if [ -z "$$STACK_YAML" ]; then
              ${cabalTest}
            else
              $stackTest
            fi
        |]

    installScriptCabal :: Text
    installScriptCabal :: Text
installScriptCabal =
        [text|
        install:
          $hlintCheck

          - $cabalUpdate
          - $cabalBuild

        script:
          - ${cabalTest}
        |]

    installScriptStack :: Text
    installScriptStack :: Text
installScriptStack =
        [text|
        install:
          $hlintCheck

          - curl -sSL https://get.haskellstack.org/ | sh
          - stack --version
          - $stackBuild

        script:
          - $stackTest
        |]

    cabalUpdate :: Text
    cabalUpdate :: Text
cabalUpdate = "cabal v2-update"

    cabalBuild :: Text
    cabalBuild :: Text
cabalBuild = "cabal v2-build --enable-tests --enable-benchmarks"

    cabalTest :: Text
    cabalTest :: Text
cabalTest = if Bool
settingsTest
        then "cabal v2-test --enable-tests"
        else "echo 'No tests'"

    stackBuild :: Text
    stackBuild :: Text
stackBuild = "stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --ghc-options=-Werror"

    stackTest :: Text
    stackTest :: Text
stackTest = "stack test --system-ghc"

    hlintCheck :: Text
    hlintCheck :: Text
hlintCheck =
        [text|
        # HLint check
        - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint .
        |]

    appVeyorYml :: Text
    appVeyorYml :: Text
appVeyorYml =
        if Bool
settingsCabal
        then Text
appVeyorYmlCabal
        else Text
appVeyorYmlStack

    appVeyorYmlCabal :: Text
    appVeyorYmlCabal :: Text
appVeyorYmlCabal = let defGhc :: Text
defGhc = GhcVer -> Text
showGhcVer GhcVer
defaultGHC in
        [text|
        clone_folder: "c:\\WORK"
        clone_depth: 5

        # Do not build feature branch with open Pull Requests
        skip_branch_with_pr: true

        platform:
          - x86_64

        cache:
          - "C:\\SR"
          - dist-newstyle

        environment:
          global:
            CABOPTS: --store-dir=C:\\SR

          matrix:
            - GHCVER: $defGhc

        install:
          - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2
          - choco install -y cabal --version 2.4.1.0
          - choco install -y ghc   --version $defGhc
          - refreshenv

        before_build:
          - cabal --version
          - ghc   --version
          - cabal %CABOPTS% v2-update

        build_script:
          - cabal %CABOPTS% v2-build --enable-tests
          - cabal %CABOPTS% v2-test  --enable-tests
        |]

    -- create appveyor.yml template
    appVeyorYmlStack :: Text
    appVeyorYmlStack :: Text
appVeyorYmlStack =
        [text|
        clone_depth: 5

        # Do not build feature branch with open Pull Requests
        skip_branch_with_pr: true

        environment:
          STACK_ROOT: C:\sr
          STACK_VERSION: 2.1.1

          # Workaround a gnarly bug https://github.com/haskell/cabal/issues/5386
          # See: https://www.fpcomplete.com/blog/2018/06/sed-a-debugging-story
          # TODO: check if it's fixed once we switch to lst-13 and GHC 8.6
          TMP: "c:\\tmp"

          matrix:
            - STACK_YAML: stack.yaml

        cache:
          - "%STACK_ROOT% -> %STACK_YAML%, appveyor.yml"
          - ".stack-work -> %STACK_YAML%, appveyor.yml"

        install:
          - choco install -y haskell-stack --version %STACK_VERSION%
          - stack setup > nul

        build_script:
          - stack build --test --bench --no-run-tests --no-run-benchmarks --ghc-options=-Werror

        test_script:
          - stack test
        |]