-- The commit is spliced in at compile time, so the splices below are literals
-- by the time the pattern checker sees them and one branch of each choice is
-- statically dead. (Agda's Agda.VersionCommit silences the same warning.)
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

-- | Which build of rzk this is: the package version, the commit it was built
-- from (when the build supplied one), the compiler and platform, and which
-- Cabal flags it was built with.
--
-- The package version itself is generated by Cabal into @Paths_rzk@, an
-- autogenerated /other/ module of the library, so a tool that links rzk cannot
-- import it. This module exposes it as part of the public API instead, together
-- with the rest of the build details, so a consumer (the @rzk@ executable, the
-- rzk-game) can report which checker it is running.
module Rzk.Version (
  -- * The package version
  version,
  versionString,

  -- * The full build description
  VersionInfo (..),
  BuildFlag (..),
  FlagState (..),
  versionInfo,
  buildFlags,
  ppVersionInfo,
  isoCommitDate,
) where

import           Data.Aeson                 (ToJSON (..), object, (.=))
import           Data.Version               (Version, showVersion)
import           Development.GitRev         (gitCommitDate, gitDirtyTracked,
                                             gitHash)
import           Language.Haskell.TH.Syntax (lift, runIO)
import           System.Environment         (lookupEnv)
import qualified System.Info

import qualified Paths_rzk

-- | The version of the @rzk@ package.
version :: Version
version :: Version
version = Version
Paths_rzk.version

-- | The version of the @rzk@ package, rendered as a string (e.g. @"0.11.2"@).
--
-- This is what @rzk version@ prints, and tools scrape it as such, so it is
-- deliberately just the version and nothing else.
versionString :: String
versionString :: String
versionString = Version -> String
showVersion Version
version

-- | Whether a Cabal flag is on for this build.
data FlagState
  = FlagOn
  | FlagOff
  deriving (FlagState -> FlagState -> Bool
(FlagState -> FlagState -> Bool)
-> (FlagState -> FlagState -> Bool) -> Eq FlagState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlagState -> FlagState -> Bool
== :: FlagState -> FlagState -> Bool
$c/= :: FlagState -> FlagState -> Bool
/= :: FlagState -> FlagState -> Bool
Eq, Int -> FlagState -> ShowS
[FlagState] -> ShowS
FlagState -> String
(Int -> FlagState -> ShowS)
-> (FlagState -> String)
-> ([FlagState] -> ShowS)
-> Show FlagState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlagState -> ShowS
showsPrec :: Int -> FlagState -> ShowS
$cshow :: FlagState -> String
show :: FlagState -> String
$cshowList :: [FlagState] -> ShowS
showList :: [FlagState] -> ShowS
Show)

-- | A Cabal flag of the @rzk@ package, with the state this build has.
data BuildFlag = BuildFlag
  { BuildFlag -> String
buildFlagName  :: String
  , BuildFlag -> FlagState
buildFlagState :: FlagState
  } deriving (BuildFlag -> BuildFlag -> Bool
(BuildFlag -> BuildFlag -> Bool)
-> (BuildFlag -> BuildFlag -> Bool) -> Eq BuildFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildFlag -> BuildFlag -> Bool
== :: BuildFlag -> BuildFlag -> Bool
$c/= :: BuildFlag -> BuildFlag -> Bool
/= :: BuildFlag -> BuildFlag -> Bool
Eq, Int -> BuildFlag -> ShowS
[BuildFlag] -> ShowS
BuildFlag -> String
(Int -> BuildFlag -> ShowS)
-> (BuildFlag -> String)
-> ([BuildFlag] -> ShowS)
-> Show BuildFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildFlag -> ShowS
showsPrec :: Int -> BuildFlag -> ShowS
$cshow :: BuildFlag -> String
show :: BuildFlag -> String
$cshowList :: [BuildFlag] -> ShowS
showList :: [BuildFlag] -> ShowS
Show)

-- | Every Cabal flag of the package, each with the state this build has.
--
-- A tool that wants a language server can look up @lsp@ here rather than run
-- @rzk lsp@ and see whether it fails.
--
-- Note that the state is what was compiled in, not what was asked for: the
-- JavaScript and WebAssembly backends have no LSP support whatever the @lsp@
-- flag says, and @lsp@ reads as off in such a build.
buildFlags :: [BuildFlag]
buildFlags :: [BuildFlag]
buildFlags =
  [ String -> FlagState -> BuildFlag
BuildFlag String
"lsp"
#ifdef LSP_ENABLED
      FlagState
FlagOn
#else
      FlagOff
#endif
  ]

-- | Everything this build knows about itself.
data VersionInfo = VersionInfo
  { VersionInfo -> Version
versionInfoVersion   :: Version
    -- ^ The package version.
  , VersionInfo -> Maybe String
versionInfoCommit    :: Maybe String
    -- ^ The commit rzk was built from, when the build knew one (see
    -- 'buildCommit'); 'Nothing' otherwise.
  , VersionInfo -> Maybe String
versionInfoCommitDate :: Maybe String
    -- ^ The date of that commit, when it came from a repository (see
    -- 'buildCommitDate').
  , VersionInfo -> String
versionInfoCompiler  :: String
    -- ^ The Haskell implementation, e.g. @"ghc-9.10.3"@.
  , VersionInfo -> String
versionInfoPlatform  :: String
    -- ^ Operating system and architecture, e.g. @"darwin-aarch64"@.
  , VersionInfo -> [BuildFlag]
versionInfoFlags     :: [BuildFlag]
    -- ^ The Cabal flags this build was made with (see 'buildFlags').
  } deriving (VersionInfo -> VersionInfo -> Bool
(VersionInfo -> VersionInfo -> Bool)
-> (VersionInfo -> VersionInfo -> Bool) -> Eq VersionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionInfo -> VersionInfo -> Bool
== :: VersionInfo -> VersionInfo -> Bool
$c/= :: VersionInfo -> VersionInfo -> Bool
/= :: VersionInfo -> VersionInfo -> Bool
Eq, Int -> VersionInfo -> ShowS
[VersionInfo] -> ShowS
VersionInfo -> String
(Int -> VersionInfo -> ShowS)
-> (VersionInfo -> String)
-> ([VersionInfo] -> ShowS)
-> Show VersionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionInfo -> ShowS
showsPrec :: Int -> VersionInfo -> ShowS
$cshow :: VersionInfo -> String
show :: VersionInfo -> String
$cshowList :: [VersionInfo] -> ShowS
showList :: [VersionInfo] -> ShowS
Show)

-- | The commit this build was made from, determined when the module is
-- compiled.
--
-- The @RZK_GIT_COMMIT@ environment variable wins when it is set; it is the only
-- route for a build with no repository to read, such as one from a Hackage
-- tarball, and the release workflow sets it. Otherwise the commit comes from
-- the checkout the build ran in, so an ordinary @stack build@ stamps itself
-- too; a tree with uncommitted changes to tracked files is marked @-dirty@.
-- The hash is reported in full, as @rustc -vV@ and @ghc --info@ do: this is the
-- verbose output, and an abbreviation can become ambiguous as a repository
-- grows.
-- A build that can find neither reports 'Nothing'.
--
-- Note that a stale stamp is possible: neither stack nor GHC tracks the
-- environment for recompilation, and stack may skip a package it considers
-- unchanged even though @HEAD@ has moved. A clean build always gets it right,
-- which is what CI does for a release binary.
buildCommit :: Maybe String
buildCommit :: Maybe String
buildCommit
  | Just String
fromEnv <- Maybe String
envCommit = String -> Maybe String
forall a. a -> Maybe a
Just String
fromEnv
  | String
hash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"UNKNOWN"         = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise                 = String -> Maybe String
forall a. a -> Maybe a
Just (String
hash String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
dirty)
  where
    hash :: String
hash = $(gitHash)
    dirty :: String
dirty
      | $(gitDirtyTracked) = String
"-dirty"
      | Bool
otherwise          = String
""

-- | The commit named by @RZK_GIT_COMMIT@ when this module was compiled.
envCommit :: Maybe String
envCommit :: Maybe String
envCommit = $(runIO (lookupEnv "RZK_GIT_COMMIT") >>= lift)

-- | The date of 'buildCommit', when the commit came from a repository.
--
-- A commit supplied through @RZK_GIT_COMMIT@ comes with no date, and reporting
-- the checkout's date next to someone else's commit would be misleading, so
-- this is 'Nothing' in that case.
buildCommitDate :: Maybe String
buildCommitDate :: Maybe String
buildCommitDate
  | Just String
_ <- Maybe String
envCommit = Maybe String
forall a. Maybe a
Nothing
  | String
date String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"UNKNOWN"   = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise           = String -> Maybe String
forall a. a -> Maybe a
Just (ShowS
isoCommitDate String
date)
  where
    date :: String
date = $(gitCommitDate)

-- | Git's default commit date (@Fri Aug 21 21:14:42 2026 +0300@) as a plain ISO
-- date (@2026-08-21@), which is the form @rustc -vV@ reports. A date that does
-- not parse is passed through unchanged.
isoCommitDate :: String -> String
isoCommitDate :: ShowS
isoCommitDate String
raw = case String -> [String]
words String
raw of
  [String
_weekday, String
month, String
day, String
_time, String
year, String
_timezone]
    | Just String
m <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
month [(String, String)]
months -> String
year String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
twoDigits String
day
  [String]
_ -> String
raw
  where
    twoDigits :: ShowS
twoDigits [Char
d] = [Char
'0', Char
d]
    twoDigits String
ds  = String
ds
    months :: [(String, String)]
months = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip
      [ String
"Jan", String
"Feb", String
"Mar", String
"Apr", String
"May", String
"Jun"
      , String
"Jul", String
"Aug", String
"Sep", String
"Oct", String
"Nov", String
"Dec" ]
      [ String
"01", String
"02", String
"03", String
"04", String
"05", String
"06"
      , String
"07", String
"08", String
"09", String
"10", String
"11", String
"12" ]

-- | The build description of the running rzk.
versionInfo :: VersionInfo
versionInfo :: VersionInfo
versionInfo = VersionInfo
  { versionInfoVersion :: Version
versionInfoVersion  = Version
version
  , versionInfoCommit :: Maybe String
versionInfoCommit   = Maybe String
buildCommit
  , versionInfoCommitDate :: Maybe String
versionInfoCommitDate = Maybe String
buildCommitDate
  , versionInfoCompiler :: String
versionInfoCompiler =
      String
System.Info.compilerName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
System.Info.fullCompilerVersion
  , versionInfoPlatform :: String
versionInfoPlatform = String
System.Info.os String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
System.Info.arch
  , versionInfoFlags :: [BuildFlag]
versionInfoFlags    = [BuildFlag]
buildFlags
  }

-- | Render a build description as a block of lines, as printed by
-- @rzk version --full@.
ppVersionInfo :: VersionInfo -> String
ppVersionInfo :: VersionInfo -> String
ppVersionInfo VersionInfo{String
[BuildFlag]
Maybe String
Version
versionInfoVersion :: VersionInfo -> Version
versionInfoCommit :: VersionInfo -> Maybe String
versionInfoCommitDate :: VersionInfo -> Maybe String
versionInfoCompiler :: VersionInfo -> String
versionInfoPlatform :: VersionInfo -> String
versionInfoFlags :: VersionInfo -> [BuildFlag]
versionInfoVersion :: Version
versionInfoCommit :: Maybe String
versionInfoCommitDate :: Maybe String
versionInfoCompiler :: String
versionInfoPlatform :: String
versionInfoFlags :: [BuildFlag]
..} = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"rzk " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
versionInfoVersion String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
commitSuffix ]
  , [String]
commitDateLine
  , [ String
"built with: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
versionInfoCompiler
    , String
"platform:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
versionInfoPlatform
    , String
"flags:      " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords ((BuildFlag -> String) -> [BuildFlag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BuildFlag -> String
ppFlag [BuildFlag]
versionInfoFlags)
    ]
  ]
  where
    commitSuffix :: String
commitSuffix = case Maybe String
versionInfoCommit of
      Maybe String
Nothing     -> String
" (commit unknown)"
      Just String
commit -> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
commit String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    commitDateLine :: [String]
commitDateLine = case Maybe String
versionInfoCommitDate of
      Maybe String
Nothing   -> []
      Just String
date -> [String
"committed:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
date]
    -- Cabal's own notation for a flag assignment, as in `cabal --flags=-lsp`.
    ppFlag :: BuildFlag -> String
ppFlag (BuildFlag String
name FlagState
state) = case FlagState
state of
      FlagState
FlagOn  -> Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
name
      FlagState
FlagOff -> Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
name

instance ToJSON FlagState where
  toJSON :: FlagState -> Value
toJSON FlagState
FlagOn  = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
True
  toJSON FlagState
FlagOff = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
False

instance ToJSON BuildFlag where
  toJSON :: BuildFlag -> Value
toJSON BuildFlag{String
FlagState
buildFlagName :: BuildFlag -> String
buildFlagState :: BuildFlag -> FlagState
buildFlagName :: String
buildFlagState :: FlagState
..} = [Pair] -> Value
object
    [ Key
"name"    Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
buildFlagName
    , Key
"enabled" Key -> FlagState -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FlagState
buildFlagState
    ]

instance ToJSON VersionInfo where
  toJSON :: VersionInfo -> Value
toJSON VersionInfo{String
[BuildFlag]
Maybe String
Version
versionInfoVersion :: VersionInfo -> Version
versionInfoCommit :: VersionInfo -> Maybe String
versionInfoCommitDate :: VersionInfo -> Maybe String
versionInfoCompiler :: VersionInfo -> String
versionInfoPlatform :: VersionInfo -> String
versionInfoFlags :: VersionInfo -> [BuildFlag]
versionInfoVersion :: Version
versionInfoCommit :: Maybe String
versionInfoCommitDate :: Maybe String
versionInfoCompiler :: String
versionInfoPlatform :: String
versionInfoFlags :: [BuildFlag]
..} = [Pair] -> Value
object
    [ Key
"version"    Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Version -> String
showVersion Version
versionInfoVersion
    , Key
"commit"     Key -> Maybe String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe String
versionInfoCommit
    , Key
"commitDate" Key -> Maybe String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe String
versionInfoCommitDate
    , Key
"compiler"   Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
versionInfoCompiler
    , Key
"platform"   Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
versionInfoPlatform
    , Key
"flags"      Key -> [BuildFlag] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [BuildFlag]
versionInfoFlags
    ]