{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Package.C.Dhall.Type ( CPkg (..)
                            , BuildVars (..)
                            , EnvVar (..)
                            , Command (..)
                            ) where

import qualified Data.Text                        as T
import           Data.Text.Prettyprint.Doc.Custom
import           Dhall
import           GHC.Natural                      (Natural)
import           Package.C.Triple.Type
import           Package.C.Type.Shared
import           Package.C.Type.Version
import           Prettyprinter

data BuildVars = BuildVars { BuildVars -> Text
installDir   :: T.Text
                           , BuildVars -> Text
currentDir   :: T.Text
                           , BuildVars -> Maybe TargetTriple
targetTriple :: Maybe TargetTriple
                           , BuildVars -> Bool
isCross      :: Bool
                           , BuildVars -> [Text]
includeDirs  :: [ T.Text ]
                           , BuildVars -> [Text]
preloadLibs  :: [ T.Text ]
                           -- TODO: nameToLinkDir function??
                           , BuildVars -> [Text]
shareDirs    :: [ T.Text ]
                           , BuildVars -> [Text]
linkDirs     :: [ T.Text ]
                           , BuildVars -> [Text]
binDirs      :: [ T.Text ]
                           , BuildVars -> OS
buildOS      :: OS
                           , BuildVars -> Arch
buildArch    :: Arch
                           , BuildVars -> Bool
static       :: Bool
                           , BuildVars -> Natural
cpus         :: Natural
                           } deriving ((forall x. BuildVars -> Rep BuildVars x)
-> (forall x. Rep BuildVars x -> BuildVars) -> Generic BuildVars
forall x. Rep BuildVars x -> BuildVars
forall x. BuildVars -> Rep BuildVars x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildVars -> Rep BuildVars x
from :: forall x. BuildVars -> Rep BuildVars x
$cto :: forall x. Rep BuildVars x -> BuildVars
to :: forall x. Rep BuildVars x -> BuildVars
Generic, InputNormalizer -> Encoder BuildVars
(InputNormalizer -> Encoder BuildVars) -> ToDhall BuildVars
forall a. (InputNormalizer -> Encoder a) -> ToDhall a
$cinjectWith :: InputNormalizer -> Encoder BuildVars
injectWith :: InputNormalizer -> Encoder BuildVars
ToDhall)

data EnvVar = EnvVar { EnvVar -> Text
var :: T.Text, EnvVar -> Text
value :: T.Text }
            deriving ((forall x. EnvVar -> Rep EnvVar x)
-> (forall x. Rep EnvVar x -> EnvVar) -> Generic EnvVar
forall x. Rep EnvVar x -> EnvVar
forall x. EnvVar -> Rep EnvVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvVar -> Rep EnvVar x
from :: forall x. EnvVar -> Rep EnvVar x
$cto :: forall x. Rep EnvVar x -> EnvVar
to :: forall x. Rep EnvVar x -> EnvVar
Generic, InputNormalizer -> Decoder EnvVar
(InputNormalizer -> Decoder EnvVar) -> FromDhall EnvVar
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder EnvVar
autoWith :: InputNormalizer -> Decoder EnvVar
FromDhall)

data Command = CreateDirectory { Command -> Text
dir :: T.Text }
             | MakeExecutable { Command -> Text
file :: T.Text }
             | Call { Command -> Text
program     :: T.Text
                    , Command -> [Text]
arguments   :: [T.Text]
                    , Command -> Maybe [EnvVar]
environment :: Maybe [EnvVar]
                    , Command -> Maybe Text
procDir     :: Maybe T.Text
                    }
             | SymlinkBinary { file :: T.Text }
             | SymlinkManpage { file :: T.Text, Command -> Natural
section :: Natural }
             | Symlink { Command -> Text
tgt :: T.Text, Command -> Text
linkName :: T.Text }
             | Write { Command -> Text
contents :: T.Text, file :: T.Text }
             | CopyFile { Command -> Text
src :: T.Text, Command -> Text
dest :: T.Text }
             | Patch { Command -> Text
patchContents :: T.Text }
             deriving ((forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Command -> Rep Command x
from :: forall x. Command -> Rep Command x
$cto :: forall x. Rep Command x -> Command
to :: forall x. Rep Command x -> Command
Generic, InputNormalizer -> Decoder Command
(InputNormalizer -> Decoder Command) -> FromDhall Command
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder Command
autoWith :: InputNormalizer -> Decoder Command
FromDhall)

data CPkg = CPkg { CPkg -> Text
pkgName          :: T.Text
                 , CPkg -> [Natural]
pkgVersion       :: [ Natural ]
                 , CPkg -> Text
pkgUrl           :: T.Text
                 , CPkg -> Text
pkgSubdir        :: T.Text
                 , CPkg -> [Dep]
pkgBuildDeps     :: [ Dep ] -- TODO: depend on target?
                 , CPkg -> [Dep]
pkgDeps          :: [ Dep ]
                 , CPkg -> BuildVars -> [Command]
configureCommand :: BuildVars -> [ Command ]
                 , CPkg -> BuildVars -> [Command]
buildCommand     :: BuildVars -> [ Command ]
                 , CPkg -> BuildVars -> [Command]
installCommand   :: BuildVars -> [ Command ]
                 -- TODO: add "description" field for printing
                 -- TODO: add "test" command for e.g. `make check`
                 } deriving ((forall x. CPkg -> Rep CPkg x)
-> (forall x. Rep CPkg x -> CPkg) -> Generic CPkg
forall x. Rep CPkg x -> CPkg
forall x. CPkg -> Rep CPkg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CPkg -> Rep CPkg x
from :: forall x. CPkg -> Rep CPkg x
$cto :: forall x. Rep CPkg x -> CPkg
to :: forall x. Rep CPkg x -> CPkg
Generic, InputNormalizer -> Decoder CPkg
(InputNormalizer -> Decoder CPkg) -> FromDhall CPkg
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder CPkg
autoWith :: InputNormalizer -> Decoder CPkg
FromDhall)

preDeps :: Doc a -> [ Dep ] -> Doc a
preDeps :: forall a. Doc a -> [Dep] -> Doc a
preDeps Doc a
_ []   = Doc a
""
preDeps Doc a
dep [Dep]
ds = Doc a
forall ann. Doc ann
hardline Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
dep Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep (Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
"," (Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc a) -> (Dep -> Text) -> Dep -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dep -> Text
name (Dep -> Doc a) -> [Dep] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dep]
ds))

prettyDeps :: [ Dep ] -> Doc a
prettyDeps :: forall a. [Dep] -> Doc a
prettyDeps = Doc a -> [Dep] -> Doc a
forall a. Doc a -> [Dep] -> Doc a
preDeps Doc a
"dependencies:"

prettyBldDeps :: [ Dep ] -> Doc a
prettyBldDeps :: forall a. [Dep] -> Doc a
prettyBldDeps = Doc a -> [Dep] -> Doc a
forall a. Doc a -> [Dep] -> Doc a
preDeps Doc a
"build dependencies:"

instance Pretty CPkg where
    pretty :: forall ann. CPkg -> Doc ann
pretty (CPkg Text
nam [Natural]
v Text
url Text
_ [Dep]
bds [Dep]
ds BuildVars -> [Command]
_ BuildVars -> [Command]
_ BuildVars -> [Command]
_) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
nam Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<##> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc ann
"url:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
url Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<##> Doc ann
"version:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Version -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Version -> Doc ann
pretty ([Natural] -> Version
Version [Natural]
v) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Dep] -> Doc ann
forall a. [Dep] -> Doc a
prettyDeps [Dep]
ds Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Dep] -> Doc ann
forall a. [Dep] -> Doc a
prettyBldDeps [Dep]
bds)