packages feed

rzk-0.11.3: src/Rzk/Version.hs

-- 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 = 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 = showVersion version

-- | Whether a Cabal flag is on for this build.
data FlagState
  = FlagOn
  | FlagOff
  deriving (Eq, Show)

-- | A Cabal flag of the @rzk@ package, with the state this build has.
data BuildFlag = BuildFlag
  { buildFlagName  :: String
  , buildFlagState :: FlagState
  } deriving (Eq, 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 "lsp"
#ifdef LSP_ENABLED
      FlagOn
#else
      FlagOff
#endif
  ]

-- | Everything this build knows about itself.
data VersionInfo = VersionInfo
  { versionInfoVersion   :: Version
    -- ^ The package version.
  , versionInfoCommit    :: Maybe String
    -- ^ The commit rzk was built from, when the build knew one (see
    -- 'buildCommit'); 'Nothing' otherwise.
  , versionInfoCommitDate :: Maybe String
    -- ^ The date of that commit, when it came from a repository (see
    -- 'buildCommitDate').
  , versionInfoCompiler  :: String
    -- ^ The Haskell implementation, e.g. @"ghc-9.10.3"@.
  , versionInfoPlatform  :: String
    -- ^ Operating system and architecture, e.g. @"darwin-aarch64"@.
  , versionInfoFlags     :: [BuildFlag]
    -- ^ The Cabal flags this build was made with (see 'buildFlags').
  } deriving (Eq, 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
  | Just fromEnv <- envCommit = Just fromEnv
  | hash == "UNKNOWN"         = Nothing
  | otherwise                 = Just (hash <> dirty)
  where
    hash = $(gitHash)
    dirty
      | $(gitDirtyTracked) = "-dirty"
      | otherwise          = ""

-- | The commit named by @RZK_GIT_COMMIT@ when this module was compiled.
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
  | Just _ <- envCommit = Nothing
  | date == "UNKNOWN"   = Nothing
  | otherwise           = Just (isoCommitDate date)
  where
    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 raw = case words raw of
  [_weekday, month, day, _time, year, _timezone]
    | Just m <- lookup month months -> year <> "-" <> m <> "-" <> twoDigits day
  _ -> raw
  where
    twoDigits [d] = ['0', d]
    twoDigits ds  = ds
    months = zip
      [ "Jan", "Feb", "Mar", "Apr", "May", "Jun"
      , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]
      [ "01", "02", "03", "04", "05", "06"
      , "07", "08", "09", "10", "11", "12" ]

-- | The build description of the running rzk.
versionInfo :: VersionInfo
versionInfo = VersionInfo
  { versionInfoVersion  = version
  , versionInfoCommit   = buildCommit
  , versionInfoCommitDate = buildCommitDate
  , versionInfoCompiler =
      System.Info.compilerName <> "-" <> showVersion System.Info.fullCompilerVersion
  , versionInfoPlatform = System.Info.os <> "-" <> System.Info.arch
  , versionInfoFlags    = buildFlags
  }

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

instance ToJSON FlagState where
  toJSON FlagOn  = toJSON True
  toJSON FlagOff = toJSON False

instance ToJSON BuildFlag where
  toJSON BuildFlag{..} = object
    [ "name"    .= buildFlagName
    , "enabled" .= buildFlagState
    ]

instance ToJSON VersionInfo where
  toJSON VersionInfo{..} = object
    [ "version"    .= showVersion versionInfoVersion
    , "commit"     .= versionInfoCommit
    , "commitDate" .= versionInfoCommitDate
    , "compiler"   .= versionInfoCompiler
    , "platform"   .= versionInfoPlatform
    , "flags"      .= versionInfoFlags
    ]