{-# LANGUAGE TemplateHaskell #-}

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

@stan@ build information.
-}

module Stan.Info
    ( -- * Version
      StanVersion (..)
    , stanVersion
    , prettyStanVersion

      -- * System
    , StanSystem (..)
    , stanSystem

      -- * Env
    , StanEnv (..)

      -- * Project Info
    , ProjectInfo (..)
    ) where

import Colourista (blue, bold, formatWith)
import Data.Version (showVersion)
import Development.GitRev (gitCommitDate, gitHash)
import System.Info (arch, compilerName, compilerVersion, os)

import qualified Paths_stan as Meta (version)


-- | @stan@ version information.
data StanVersion = StanVersion
    { StanVersion -> String
svVersion     :: !String
    , StanVersion -> String
svGitRevision :: !String
    , StanVersion -> String
svCommitDate  :: !String
    } deriving stock (Int -> StanVersion -> ShowS
[StanVersion] -> ShowS
StanVersion -> String
(Int -> StanVersion -> ShowS)
-> (StanVersion -> String)
-> ([StanVersion] -> ShowS)
-> Show StanVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StanVersion] -> ShowS
$cshowList :: [StanVersion] -> ShowS
show :: StanVersion -> String
$cshow :: StanVersion -> String
showsPrec :: Int -> StanVersion -> ShowS
$cshowsPrec :: Int -> StanVersion -> ShowS
Show, StanVersion -> StanVersion -> Bool
(StanVersion -> StanVersion -> Bool)
-> (StanVersion -> StanVersion -> Bool) -> Eq StanVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StanVersion -> StanVersion -> Bool
$c/= :: StanVersion -> StanVersion -> Bool
== :: StanVersion -> StanVersion -> Bool
$c== :: StanVersion -> StanVersion -> Bool
Eq)

{- | Current @stan@ version information.
-}
stanVersion :: StanVersion
stanVersion :: StanVersion
stanVersion = $WStanVersion :: String -> String -> String -> StanVersion
StanVersion
    { svVersion :: String
svVersion     = Version -> String
showVersion Version
Meta.version
    , svGitRevision :: String
svGitRevision = $(gitHash)
    , svCommitDate :: String
svCommitDate  = $(gitCommitDate)
    }

{- | Colourful pretty 'StanVersion' representation used in the @CLI@.
-}
prettyStanVersion :: StanVersion -> String
prettyStanVersion :: StanVersion -> String
prettyStanVersion StanVersion{..} = ShowS
forall a. ToString a => a -> String
toString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n"
    [ String
sVersion
    , String
sHash
    , String
sDate
    ]
  where
    fmt :: String -> String
    fmt :: ShowS
fmt = [String] -> ShowS
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [String
forall str. IsString str => str
blue, String
forall str. IsString str => str
bold]

    sVersion, sHash, sDate :: String
    sVersion :: String
sVersion = ShowS
fmt ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "Stan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "v" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
svVersion
    sHash :: String
sHash = " ➤ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
fmt "Git revision: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
svGitRevision
    sDate :: String
sDate = " ➤ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
fmt "Commit date:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
svCommitDate

{- | Contains all @stan@ System information
-}
data StanSystem = StanSystem
    { StanSystem -> String
ssOs              :: !String
    , StanSystem -> String
ssArch            :: !String
    , StanSystem -> String
ssCompiler        :: !String
    , StanSystem -> String
ssCompilerVersion :: !String
    } deriving stock (Int -> StanSystem -> ShowS
[StanSystem] -> ShowS
StanSystem -> String
(Int -> StanSystem -> ShowS)
-> (StanSystem -> String)
-> ([StanSystem] -> ShowS)
-> Show StanSystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StanSystem] -> ShowS
$cshowList :: [StanSystem] -> ShowS
show :: StanSystem -> String
$cshow :: StanSystem -> String
showsPrec :: Int -> StanSystem -> ShowS
$cshowsPrec :: Int -> StanSystem -> ShowS
Show, StanSystem -> StanSystem -> Bool
(StanSystem -> StanSystem -> Bool)
-> (StanSystem -> StanSystem -> Bool) -> Eq StanSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StanSystem -> StanSystem -> Bool
$c/= :: StanSystem -> StanSystem -> Bool
== :: StanSystem -> StanSystem -> Bool
$c== :: StanSystem -> StanSystem -> Bool
Eq)

-- | All system info for the project
stanSystem :: StanSystem
stanSystem :: StanSystem
stanSystem = $WStanSystem :: String -> String -> String -> String -> StanSystem
StanSystem
    { ssOs :: String
ssOs              = String
os
    , ssArch :: String
ssArch            = String
arch
    , ssCompiler :: String
ssCompiler        = String
compilerName
    , ssCompilerVersion :: String
ssCompilerVersion = Version -> String
showVersion Version
compilerVersion
    }

{- | Data from different environment resources:

* Environment variables
* Used TOML configuration files
* Command Line arguments
-}
data StanEnv = StanEnv
    { StanEnv -> Text
seEnvVars   :: !Text
    , StanEnv -> [String]
seTomlFiles :: ![FilePath]
    , StanEnv -> [String]
seCliArgs   :: ![String]
    } deriving stock (Int -> StanEnv -> ShowS
[StanEnv] -> ShowS
StanEnv -> String
(Int -> StanEnv -> ShowS)
-> (StanEnv -> String) -> ([StanEnv] -> ShowS) -> Show StanEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StanEnv] -> ShowS
$cshowList :: [StanEnv] -> ShowS
show :: StanEnv -> String
$cshow :: StanEnv -> String
showsPrec :: Int -> StanEnv -> ShowS
$cshowsPrec :: Int -> StanEnv -> ShowS
Show, StanEnv -> StanEnv -> Bool
(StanEnv -> StanEnv -> Bool)
-> (StanEnv -> StanEnv -> Bool) -> Eq StanEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StanEnv -> StanEnv -> Bool
$c/= :: StanEnv -> StanEnv -> Bool
== :: StanEnv -> StanEnv -> Bool
$c== :: StanEnv -> StanEnv -> Bool
Eq)


data ProjectInfo = ProjectInfo
    { ProjectInfo -> String
piName       :: !String
    , ProjectInfo -> [String]
piCabalFiles :: ![FilePath]
    , ProjectInfo -> String
piHieDir     :: !FilePath
    , ProjectInfo -> Int
piFileNumber :: !Int
    } deriving stock (Int -> ProjectInfo -> ShowS
[ProjectInfo] -> ShowS
ProjectInfo -> String
(Int -> ProjectInfo -> ShowS)
-> (ProjectInfo -> String)
-> ([ProjectInfo] -> ShowS)
-> Show ProjectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectInfo] -> ShowS
$cshowList :: [ProjectInfo] -> ShowS
show :: ProjectInfo -> String
$cshow :: ProjectInfo -> String
showsPrec :: Int -> ProjectInfo -> ShowS
$cshowsPrec :: Int -> ProjectInfo -> ShowS
Show, ProjectInfo -> ProjectInfo -> Bool
(ProjectInfo -> ProjectInfo -> Bool)
-> (ProjectInfo -> ProjectInfo -> Bool) -> Eq ProjectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectInfo -> ProjectInfo -> Bool
$c/= :: ProjectInfo -> ProjectInfo -> Bool
== :: ProjectInfo -> ProjectInfo -> Bool
$c== :: ProjectInfo -> ProjectInfo -> Bool
Eq)