-- |
-- Module: Staversion.Internal.BuildPlan.Version
-- Description: parsing Version
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.BuildPlan.Version
       ( parseVersionText,
         VersionJSON(..)
       ) where

import Control.Applicative (empty, pure)
import Data.Aeson (FromJSON(..), Value(..))
import Data.Maybe (listToMaybe)
import Data.Text (Text, unpack)

import Staversion.Internal.Version (parseVersionText, Version)

-- | a wrapper around 'Version' for JSON I/F
newtype VersionJSON = VersionJSON { VersionJSON -> Version
unVersionJSON :: Version } deriving (Int -> VersionJSON -> ShowS
[VersionJSON] -> ShowS
VersionJSON -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionJSON] -> ShowS
$cshowList :: [VersionJSON] -> ShowS
show :: VersionJSON -> String
$cshow :: VersionJSON -> String
showsPrec :: Int -> VersionJSON -> ShowS
$cshowsPrec :: Int -> VersionJSON -> ShowS
Show,VersionJSON -> VersionJSON -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionJSON -> VersionJSON -> Bool
$c/= :: VersionJSON -> VersionJSON -> Bool
== :: VersionJSON -> VersionJSON -> Bool
$c== :: VersionJSON -> VersionJSON -> Bool
Eq,Eq VersionJSON
VersionJSON -> VersionJSON -> Bool
VersionJSON -> VersionJSON -> Ordering
VersionJSON -> VersionJSON -> VersionJSON
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionJSON -> VersionJSON -> VersionJSON
$cmin :: VersionJSON -> VersionJSON -> VersionJSON
max :: VersionJSON -> VersionJSON -> VersionJSON
$cmax :: VersionJSON -> VersionJSON -> VersionJSON
>= :: VersionJSON -> VersionJSON -> Bool
$c>= :: VersionJSON -> VersionJSON -> Bool
> :: VersionJSON -> VersionJSON -> Bool
$c> :: VersionJSON -> VersionJSON -> Bool
<= :: VersionJSON -> VersionJSON -> Bool
$c<= :: VersionJSON -> VersionJSON -> Bool
< :: VersionJSON -> VersionJSON -> Bool
$c< :: VersionJSON -> VersionJSON -> Bool
compare :: VersionJSON -> VersionJSON -> Ordering
$ccompare :: VersionJSON -> VersionJSON -> Ordering
Ord)

instance FromJSON VersionJSON where
  parseJSON :: Value -> Parser VersionJSON
parseJSON (String Text
t) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> VersionJSON
VersionJSON forall a b. (a -> b) -> a -> b
$ Text -> Maybe Version
parseVersionText Text
t
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty