{-# LANGUAGE TemplateHaskell #-}
module PostgREST.Version
  ( docsVersion
  , prettyVersion
  ) where

import qualified Data.ByteString as BS
import qualified Data.Text       as T

import Data.Version       (showVersion, versionBranch)
import Development.GitRev (gitHash)
import Paths_postgrest    (version)

import Protolude


-- | User friendly version number such as '1.1.1'.
-- Pre-release versions are tagged as such, e.g., '1.1.1.1 (pre-release)'.
-- If a git hash is available, it's added to the version, e.g., '1.1.1 (abcdef0)'.
prettyVersion :: ByteString
prettyVersion :: ByteString
prettyVersion =
  String -> ByteString
forall a. ConvertText a Text => a -> ByteString
toUtf8 (Version -> String
showVersion Version
version) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
preRelease ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
gitRev
  where
    gitRev :: ByteString
gitRev =
      if $(Text
gitHash) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"UNKNOWN" :: Text) then
        ByteString
forall a. Monoid a => a
mempty
      else
        ByteString
" (" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.take Int
7 $(ByteString
gitHash) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
    preRelease :: ByteString
preRelease = if Bool
isPreRelease then ByteString
" (pre-release)" else ByteString
forall a. Monoid a => a
mempty


-- | Version number used in docs.
-- Uses only the two first components of the version. Example: 'v1.1'
docsVersion :: Text
docsVersion :: Text
docsVersion =
  Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> ([Int] -> [Text]) -> [Int] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ([Int] -> [Text]) -> ([Int] -> [Int]) -> [Int] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 ([Int] -> Text) -> [Int] -> Text
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version)


-- | Versions with four components (e.g., '1.1.1.1') are treated as pre-releases.
isPreRelease :: Bool
isPreRelease :: Bool
isPreRelease =
  [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Version -> [Int]
versionBranch Version
version) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4