{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
-- Template of PKGBUILD file.
module Distribution.ArchHs.PkgBuild
  ( PkgBuild (..),
    ArchLicense,
    mapLicense,
    applyTemplate,
    felixTemplate,
    metaTemplate,
  )
where

import Data.Text (Text, pack, unpack)
import Distribution.SPDX.LicenseId
import NeatInterpolation (text)

-- | PkgBuild data type, representing needed information in filling the 'felixTemplate'.
data PkgBuild = PkgBuild
  { -- | Field @_hkgName@.
    PkgBuild -> String
_hkgName :: String,
    -- | Field @pkgname@
    PkgBuild -> String
_pkgName :: String,
    -- | Field @pkgver@
    PkgBuild -> String
_pkgVer :: String,
    -- | Field @pkgdesc@
    PkgBuild -> String
_pkgDesc :: String,
    -- | Field @url@
    PkgBuild -> String
_url :: String,
    -- | Field @license@
    PkgBuild -> String
_license :: String,
    -- | Array @depends@, which has been joined into 'String'
    PkgBuild -> String
_depends :: String,
    -- | Array @makedepends@, which has been joined into 'String'
    PkgBuild -> String
_makeDepends :: String,
    -- | Field @sha256sums@
    PkgBuild -> String
_sha256sums :: String,
    -- | License file name
    PkgBuild -> Maybe String
_licenseFile :: Maybe String,
    -- | Whether generate @prepare()@ bash function which calls @uusi@
    PkgBuild -> Bool
_enableUusi :: Bool,
    -- | Whether generate @check()@ bash function
    PkgBuild -> Bool
_enableCheck :: Bool
  }

-- | Licenses available in <https://www.archlinux.org/packages/core/any/licenses/ licenses>.
data ArchLicense
  = AGPL3
  | Apache
  | Artistic2_0
  | CDDL
  | CPL
  | EPL
  | FDL1_2
  | FDL1_3
  | GPL2
  | GPL3
  | LGPL2_1
  | LGPL3
  | LPPL
  | MPL
  | MPL2
  | PHP
  | PSF
  | PerlArtistic
  | RUBY
  | Unlicense
  | W3C
  | ZPL
  | Custom String

instance Show ArchLicense where
  show :: ArchLicense -> String
show ArchLicense
AGPL3 = String
"AGPL"
  show ArchLicense
Apache = String
"Apache"
  show ArchLicense
Artistic2_0 = String
"Artistic2.0"
  show ArchLicense
CDDL = String
"CDDL"
  show ArchLicense
CPL = String
"CPL"
  show ArchLicense
EPL = String
"EPL"
  show ArchLicense
FDL1_2 = String
"FDL1.2"
  show ArchLicense
FDL1_3 = String
"FDL1.3"
  show ArchLicense
GPL2 = String
"GPL2"
  show ArchLicense
GPL3 = String
"GPL3"
  show ArchLicense
LGPL2_1 = String
"LGPL2.1"
  show ArchLicense
LGPL3 = String
"LGPL3"
  show ArchLicense
LPPL = String
"LPPL"
  show ArchLicense
MPL = String
"MPL"
  show ArchLicense
MPL2 = String
"MPL2"
  show ArchLicense
PHP = String
"PHP"
  show ArchLicense
PSF = String
"PSF"
  show ArchLicense
PerlArtistic = String
"PerlArtistic"
  show ArchLicense
RUBY = String
"RUBY"
  show ArchLicense
Distribution.ArchHs.PkgBuild.Unlicense = String
"Unlicense"
  show ArchLicense
Distribution.ArchHs.PkgBuild.W3C = String
"W3C"
  show ArchLicense
ZPL = String
"ZPL"
  show (Custom String
x) = String
"custom:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x

-- | Map 'LicenseId' to 'ArchLicense'. License not provided by system will be mapped to @custom:...@.
mapLicense :: LicenseId -> ArchLicense
mapLicense :: LicenseId -> ArchLicense
mapLicense LicenseId
AGPL_3_0_only = ArchLicense
AGPL3
mapLicense LicenseId
Apache_2_0 = ArchLicense
Apache
mapLicense LicenseId
Artistic_2_0 = ArchLicense
Artistic2_0
mapLicense LicenseId
CDDL_1_0 = ArchLicense
CDDL
mapLicense LicenseId
CPL_1_0 = ArchLicense
CPL
mapLicense LicenseId
EPL_1_0 = ArchLicense
EPL
mapLicense LicenseId
GFDL_1_2_only = ArchLicense
FDL1_2
mapLicense LicenseId
GFDL_1_3_only = ArchLicense
FDL1_3
mapLicense LicenseId
GPL_2_0_only = ArchLicense
GPL2
mapLicense LicenseId
GPL_3_0_only = ArchLicense
GPL3
mapLicense LicenseId
LGPL_2_1_only = ArchLicense
LGPL2_1
mapLicense LicenseId
LGPL_3_0_only = ArchLicense
LGPL3
mapLicense LicenseId
LPPL_1_3c = ArchLicense
LPPL
mapLicense LicenseId
MPL_1_0 = ArchLicense
MPL
mapLicense LicenseId
MPL_2_0 = ArchLicense
MPL2
mapLicense LicenseId
PHP_3_01 = ArchLicense
PHP
mapLicense LicenseId
Python_2_0 = ArchLicense
PSF
mapLicense LicenseId
Artistic_1_0_Perl = ArchLicense
PerlArtistic
mapLicense LicenseId
Ruby = ArchLicense
RUBY
mapLicense LicenseId
ZPL_2_1 = ArchLicense
ZPL
mapLicense LicenseId
Distribution.SPDX.LicenseId.Unlicense = ArchLicense
Distribution.ArchHs.PkgBuild.Unlicense
mapLicense LicenseId
Distribution.SPDX.LicenseId.W3C = ArchLicense
Distribution.ArchHs.PkgBuild.W3C
mapLicense LicenseId
BSD_3_Clause = String -> ArchLicense
Custom String
"BSD3"
mapLicense LicenseId
x = String -> ArchLicense
Custom (String -> ArchLicense) -> String -> ArchLicense
forall a b. (a -> b) -> a -> b
$ LicenseId -> String
forall a. Show a => a -> String
show LicenseId
x

-- | Apply 'PkgBuild' to 'felixTemplate'.
applyTemplate :: PkgBuild -> String
applyTemplate :: PkgBuild -> String
applyTemplate PkgBuild {Bool
String
Maybe String
_enableCheck :: Bool
_enableUusi :: Bool
_licenseFile :: Maybe String
_sha256sums :: String
_makeDepends :: String
_depends :: String
_license :: String
_url :: String
_pkgDesc :: String
_pkgVer :: String
_pkgName :: String
_hkgName :: String
_enableCheck :: PkgBuild -> Bool
_enableUusi :: PkgBuild -> Bool
_licenseFile :: PkgBuild -> Maybe String
_sha256sums :: PkgBuild -> String
_makeDepends :: PkgBuild -> String
_depends :: PkgBuild -> String
_license :: PkgBuild -> String
_url :: PkgBuild -> String
_pkgDesc :: PkgBuild -> String
_pkgVer :: PkgBuild -> String
_pkgName :: PkgBuild -> String
_hkgName :: PkgBuild -> String
..} =
  Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
felixTemplate
      (String -> Text
pack String
_hkgName)
      (String -> Text
pack String
_pkgName)
      (String -> Text
pack String
_pkgVer)
      (String -> Text
pack String
_pkgDesc)
      (String -> Text
pack String
_url)
      (String -> Text
pack String
_license)
      (String -> Text
pack String
_depends)
      (String -> Text
pack String
_makeDepends)
      (String -> Text
pack String
_sha256sums)
      ( case Maybe String
_licenseFile of
          Just String
n -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
installLicense (String -> Text
pack String
n)
          Maybe String
_ -> Text
"\n"
      )
      (if Bool
_enableUusi then Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uusi Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" else Text
"\n")
      (if Bool
_enableCheck then Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
check Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" else Text
"\n")

-- | Text of @check()@ function.
check :: Text
check :: Text
check =
  [text|
  check() {
    cd $$_hkgname-$$pkgver
    runhaskell Setup test
  }
|]

-- | Text of statements which install license.
installLicense :: Text -> Text
installLicense :: Text -> Text
installLicense Text
licenseFile =
  [text|
    install -D -m644 $licenseFile -t "$$pkgdir"/usr/share/licenses/$$pkgname/
    rm -f "$$pkgdir"/usr/share/doc/$$pkgname/$licenseFile
|]

uusi :: Text
uusi :: Text
uusi =
  [text|
  prepare() {
    uusi $$_hkgname-$$pkgver/$$_hkgname.cabal
  }
|]

-- | A fixed template of haskell package in archlinux. See <https://wiki.archlinux.org/index.php/Haskell_package_guidelines Haskell package guidelines> .
felixTemplate :: Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text
felixTemplate :: Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
felixTemplate Text
hkgname Text
pkgname Text
pkgver Text
pkgdesc Text
url Text
license Text
depends Text
makedepends Text
sha256sums Text
licenseF Text
uusiF Text
checkF =
  [text|
  # This file was generated by https://github.com/berberman/arch-hs, please check it manually.
  # Maintainer: Your Name <youremail@domain.com>

  _hkgname=$hkgname
  pkgname=$pkgname
  pkgver=$pkgver
  pkgrel=1
  pkgdesc="$pkgdesc"
  url="$url"
  license=("$license")
  arch=('x86_64')
  depends=('ghc-libs'$depends)
  makedepends=('ghc'$makedepends)
  source=("https://hackage.haskell.org/packages/archive/$$_hkgname/$$pkgver/$$_hkgname-$$pkgver.tar.gz")
  sha256sums=($sha256sums)
  $uusiF
  build() {
    cd $$_hkgname-$$pkgver

    runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \
      --prefix=/usr --docdir=/usr/share/doc/$$pkgname --enable-tests \
      --dynlibdir=/usr/lib --libsubdir=\$$compiler/site-local/\$$pkgid \
      --ghc-option=-optl-Wl\,-z\,relro\,-z\,now \
      --ghc-option='-pie'

    runhaskell Setup build
    runhaskell Setup register --gen-script
    runhaskell Setup unregister --gen-script
    sed -i -r -e "s|ghc-pkg.*update[^ ]* |&'--force' |" register.sh
    sed -i -r -e "s|ghc-pkg.*unregister[^ ]* |&'--force' |" unregister.sh
  }
  $checkF
  package() {
    cd $$_hkgname-$$pkgver

    install -D -m744 register.sh "$$pkgdir"/usr/share/haskell/register/$$pkgname.sh
    install -D -m744 unregister.sh "$$pkgdir"/usr/share/haskell/unregister/$$pkgname.sh
    runhaskell Setup copy --destdir="$$pkgdir"$licenseF
  }
|]

-- | A fixed template of a haskell meta package.
metaTemplate :: Text -> Text -> Text -> Text -> Text
metaTemplate :: Text -> Text -> Text -> Text -> Text
metaTemplate Text
url Text
pkgname Text
comment Text
depends =
  [text|
  # This file was generated by https://github.com/berberman/arch-hs, please check it manually.
  # This is a meta package, containing only dependencies of the target.
  # Maintainer: Your Name <youremail@domain.com>

  pkgname=haskell-$pkgname-meta
  pkgver=1
  pkgrel=1
  pkgdesc="Dependencies of $pkgname"
  url="$url"
  arch=('x86_64')
  $comment
  depends=('ghc-libs'$depends)
  |]