-- |
-- 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
(Int -> VersionJSON -> ShowS)
-> (VersionJSON -> String)
-> ([VersionJSON] -> ShowS)
-> Show VersionJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionJSON -> ShowS
showsPrec :: Int -> VersionJSON -> ShowS
$cshow :: VersionJSON -> String
show :: VersionJSON -> String
$cshowList :: [VersionJSON] -> ShowS
showList :: [VersionJSON] -> ShowS
Show,VersionJSON -> VersionJSON -> Bool
(VersionJSON -> VersionJSON -> Bool)
-> (VersionJSON -> VersionJSON -> Bool) -> Eq VersionJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionJSON -> VersionJSON -> Bool
== :: VersionJSON -> VersionJSON -> Bool
$c/= :: VersionJSON -> VersionJSON -> Bool
/= :: VersionJSON -> VersionJSON -> Bool
Eq,Eq VersionJSON
Eq VersionJSON =>
(VersionJSON -> VersionJSON -> Ordering)
-> (VersionJSON -> VersionJSON -> Bool)
-> (VersionJSON -> VersionJSON -> Bool)
-> (VersionJSON -> VersionJSON -> Bool)
-> (VersionJSON -> VersionJSON -> Bool)
-> (VersionJSON -> VersionJSON -> VersionJSON)
-> (VersionJSON -> VersionJSON -> VersionJSON)
-> Ord 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
$ccompare :: VersionJSON -> VersionJSON -> Ordering
compare :: VersionJSON -> VersionJSON -> Ordering
$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
>= :: VersionJSON -> VersionJSON -> Bool
$cmax :: VersionJSON -> VersionJSON -> VersionJSON
max :: VersionJSON -> VersionJSON -> VersionJSON
$cmin :: VersionJSON -> VersionJSON -> VersionJSON
min :: VersionJSON -> VersionJSON -> VersionJSON
Ord)

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