{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module PostgREST.Version
  ( docsVersion
  , prettyVersion
  ) where

import qualified Data.Text as T

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

import Protolude


-- | User friendly version number
prettyVersion :: Text
prettyVersion :: Text
prettyVersion =
  Text -> [Text] -> Text
T.intercalate Text
"." ((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] -> [Text]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gitRev
  where
    gitRev :: Text
gitRev =
      if $(String
gitHash) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"UNKNOWN"
        then Text
forall a. Monoid a => a
mempty
        else Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
7 $(Text
gitHash) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Version number used in docs
docsVersion :: Text
docsVersion :: Text
docsVersion = Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.dropEnd Int
1 ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
prettyVersion)