{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TemplateHaskell   #-}

{-|
Module      : Headroom.Meta.Version
Description : Type safe representation of Haskell PVP version
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains data types and functions for working with
Haskell PVP versions (<https://pvp.haskell.org/faq/>) in type safe way.
-}

module Headroom.Meta.Version
  ( Version(..)
  , parseVersion
  , printVersion
  , printVersionP
  , pvp
  )
where

import           Data.Aeson                          ( FromJSON(..)
                                                     , Value(String)
                                                     )
import           Headroom.Data.Regex                 ( match
                                                     , re
                                                     )
import qualified Headroom.Data.Text                 as T
import           Language.Haskell.TH.Quote           ( QuasiQuoter(..) )
import           RIO
import qualified RIO.Text                           as T


---------------------------------  DATA TYPES  ---------------------------------

-- | Type safe representation of /PVP/ version.
data Version = Version
  { Version -> Int
vMajor1 :: Int
  -- ^ first major version
  , Version -> Int
vMajor2 :: Int
  -- ^ second major version
  , Version -> Int
vMinor  :: Int
  -- ^ minor version
  , Version -> Int
vPatch  :: Int
  -- ^ patch level version
  }
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)


instance Ord Version where
  compare :: Version -> Version -> Ordering
compare (Version Int
a1 Int
b1 Int
c1 Int
d1) (Version Int
a2 Int
b2 Int
c2 Int
d2) = [(Int, Int)] -> Ordering
forall a. Ord a => [(a, a)] -> Ordering
go [(Int, Int)]
pairs
   where
    pairs :: [(Int, Int)]
pairs = [(Int
a1, Int
a2), (Int
b1, Int
b2), (Int
c1, Int
c2), (Int
d1, Int
d2)]
    go :: [(a, a)] -> Ordering
go [] = Ordering
EQ
    go ((a
x, a
y) : [(a, a)]
xs) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y    = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y
                     | Bool
otherwise = [(a, a)] -> Ordering
go [(a, a)]
xs


instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON (String Text
s) = Parser Version
-> (Version -> Parser Version) -> Maybe Version -> Parser Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Version
forall a. HasCallStack => String -> a
error (String -> Parser Version)
-> (Text -> String) -> Text -> Parser Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
errorMsg (Text -> Parser Version) -> Text -> Parser Version
forall a b. (a -> b) -> a -> b
$ Text
s) Version -> Parser Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Version
parseVersion Text
s)
  parseJSON Value
other      = String -> Parser Version
forall a. HasCallStack => String -> a
error (String -> Parser Version)
-> (Value -> String) -> Value -> Parser Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
errorMsg (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. Show a => a -> Text
tshow (Value -> Parser Version) -> Value -> Parser Version
forall a b. (a -> b) -> a -> b
$ Value
other


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Parses 'Version' from given text.
--
-- >>> parseVersion "0.3.2.0"
-- Just (Version {vMajor1 = 0, vMajor2 = 3, vMinor = 2, vPatch = 0})
parseVersion :: Text
             -- ^ input text to parse version from
             -> Maybe Version
             -- ^ parsed 'Version'
parseVersion :: Text -> Maybe Version
parseVersion Text
raw = do
  [Text]
groups <- Regex -> Text -> Maybe [Text]
match [re|^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$|] Text
raw
  [Int] -> Maybe Version
check ([Int] -> Maybe Version)
-> ([Maybe Int] -> [Int]) -> [Maybe Int] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> Maybe Version) -> [Maybe Int] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall a. Read a => Text -> Maybe a
T.read (Text -> Maybe Int) -> [Text] -> [Maybe Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
groups
 where
  check :: [Int] -> Maybe Version
check [Int
ma1, Int
ma2, Int
mi, Int
p] = Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Version
Version Int
ma1 Int
ma2 Int
mi Int
p
  check [Int]
_                 = Maybe Version
forall a. Maybe a
Nothing


-- | Prints 'Version' in @major1.major2.minor.patch@ format.
--
-- >>> printVersion (Version 0 3 2 0)
-- "0.3.2.0"
printVersion :: Version
             -- ^ 'Version' to print
             -> Text
             -- ^ textual representation
printVersion :: Version -> Text
printVersion (Version Int
ma1 Int
ma2 Int
mi Int
p) = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
chunks
  where chunks :: [Text]
chunks = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
ma1, Int
ma2, Int
mi, Int
p]


-- | Similar to 'printVersion', but adds the @v@ prefix in front of the version
-- number.
--
-- >>> printVersionP (Version 0 3 2 0)
-- "v0.3.2.0"
printVersionP :: Version -> Text
printVersionP :: Version -> Text
printVersionP = (Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Version -> Text) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
printVersion


-- | QuasiQuoter for defining 'Version' values checked at compile time.
--
-- >>> [pvp|1.2.3.4|]
-- Version {vMajor1 = 1, vMajor2 = 2, vMinor = 3, vPatch = 4}
pvp :: QuasiQuoter
pvp :: QuasiQuoter
pvp = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
quoteExpVersion
                  , quotePat :: String -> Q Pat
quotePat  = String -> Q Pat
forall a. HasCallStack => a
undefined
                  , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
                  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> Q [Dec]
forall a. HasCallStack => a
undefined
                  }
 where
  quoteExpVersion :: String -> Q Exp
quoteExpVersion String
txt = [| parseVersionUnsafe . T.pack $ txt |]
    where !Version
_ = Text -> Version
parseVersionUnsafe (Text -> Version) -> (String -> Text) -> String -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Version) -> String -> Version
forall a b. (a -> b) -> a -> b
$ String
txt -- check at compile time


------------------------------  PRIVATE FUNCTIONS  -----------------------------

parseVersionUnsafe :: Text -> Version
parseVersionUnsafe :: Text -> Version
parseVersionUnsafe Text
raw = case Text -> Maybe Version
parseVersion Text
raw of
  Maybe Version
Nothing  -> String -> Version
forall a. HasCallStack => String -> a
error (String -> Version) -> (Text -> String) -> Text -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
errorMsg (Text -> Version) -> Text -> Version
forall a b. (a -> b) -> a -> b
$ Text
raw
  Just Version
res -> Version
res

errorMsg :: Text -> String
errorMsg :: Text -> String
errorMsg Text
raw = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
  [ String
"Value '"
  , Text -> String
T.unpack Text
raw
  , String
"' is not valid PVP version string. Please define correct version in "
  , String
"format 'MAJOR1.MAJOR2.MINOR.PATCH' (e.g. '0.4.1.2')."
  ]