{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-} -- for Reifies constraints in instances
module Voting.Protocol.Version where

import Control.Applicative (Applicative(..), Alternative(..))
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..))
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.), id)
import Data.Functor ((<$>), (<$))
import Data.Maybe (Maybe(..), fromJust)
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Reflection (Reifies(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.TypeLits (Nat, Symbol, natVal, symbolVal, KnownNat, KnownSymbol)
import Numeric.Natural (Natural)
import Prelude (fromIntegral)
import Text.Show (Show(..), showChar, showString, shows)
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Text.ParserCombinators.ReadP as Read
import qualified Text.Read as Read

import Voting.Protocol.Utils

-- * Type 'Version'
-- | Version of the Helios-C protocol.
data Version = Version
 { Version -> [Natural]
version_branch :: [Natural]
 , Version -> [(Text, Natural)]
version_tags   :: [(Text, Natural)]
 } 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,Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord,(forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic,Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
rnf :: Version -> ()
$crnf :: Version -> ()
NFData)
instance IsString Version where
	fromString :: String -> Version
fromString = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version)
-> (String -> Maybe Version) -> String -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Version
readVersion
instance Show Version where
	showsPrec :: Int -> Version -> ShowS
showsPrec Int
_p Version{[Natural]
[(Text, Natural)]
version_tags :: [(Text, Natural)]
version_branch :: [Natural]
version_tags :: Version -> [(Text, Natural)]
version_branch :: Version -> [Natural]
..} =
		(ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id
		 (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
List.intersperse (Char -> ShowS
showChar Char
'.') ([ShowS] -> [ShowS]) -> [ShowS] -> [ShowS]
forall a b. (a -> b) -> a -> b
$
			Natural -> ShowS
forall a. Show a => a -> ShowS
shows (Natural -> ShowS) -> [Natural] -> [ShowS]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural]
version_branch) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id
		 ((\(Text
t,Natural
n) -> Char -> ShowS
showChar Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Text -> String
Text.unpack Text
t) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
			if Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 then Natural -> ShowS
forall a. Show a => a -> ShowS
shows Natural
n else ShowS
forall a. a -> a
id)
		 ((Text, Natural) -> ShowS) -> [(Text, Natural)] -> [ShowS]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Natural)]
version_tags)
instance ToJSON Version where
	toJSON :: Version -> Value
toJSON     = String -> Value
forall a. ToJSON a => a -> Value
toJSON     (String -> Value) -> (Version -> String) -> Version -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Show a => a -> String
show
	toEncoding :: Version -> Encoding
toEncoding = String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (String -> Encoding) -> (Version -> String) -> Version -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Show a => a -> String
show
instance FromJSON Version where
	parseJSON :: Value -> Parser Version
parseJSON (JSON.String Text
s)
	 | Just Version
v <- String -> Maybe Version
readVersion (Text -> String
Text.unpack Text
s)
	 = Version -> Parser Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
	parseJSON Value
json = String -> Value -> Parser Version
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"Version" Value
json

hasVersionTag :: Version -> Text -> Bool
hasVersionTag :: Version -> Text -> Bool
hasVersionTag Version
v Text
tag = ((Text, Natural) -> Bool) -> [(Text, Natural)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any (\(Text
t,Natural
_n) -> Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag) (Version -> [(Text, Natural)]
version_tags Version
v)

-- ** Type 'ExperimentalVersion'
type ExperimentalVersion = V [1,6] '[ '(VersionTagQuicker,0)]
experimentalVersion :: Version
experimentalVersion :: Version
experimentalVersion = Version
stableVersion{version_tags :: [(Text, Natural)]
version_tags = [(Text
versionTagQuicker,Natural
0)]}

-- ** Type 'StableVersion'
type StableVersion = V [1,6] '[]
stableVersion :: Version
stableVersion :: Version
stableVersion = Version
"1.6"

-- ** Type 'VersionTagQuicker'
type VersionTagQuicker = "quicker"
versionTagQuicker :: Text
versionTagQuicker :: Text
versionTagQuicker = Text
"quicker"

readVersion :: String -> Maybe Version
readVersion :: String -> Maybe Version
readVersion = ReadP Version -> String -> Maybe Version
forall a. ReadP a -> String -> Maybe a
parseReadP (ReadP Version -> String -> Maybe Version)
-> ReadP Version -> String -> Maybe Version
forall a b. (a -> b) -> a -> b
$ do
	[Natural]
version_branch <- ReadP Natural -> ReadP Char -> ReadP [Natural]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
Read.sepBy1
	 (String -> Natural
forall a. Read a => String -> a
Read.read (String -> Natural) -> ReadP String -> ReadP Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
Read.munch1 Char -> Bool
Char.isDigit)
	 (Char -> ReadP Char
Read.char Char
'.')
	[(Text, Natural)]
version_tags <- ReadP (Text, Natural) -> ReadP [(Text, Natural)]
forall a. ReadP a -> ReadP [a]
Read.many (ReadP (Text, Natural) -> ReadP [(Text, Natural)])
-> ReadP (Text, Natural) -> ReadP [(Text, Natural)]
forall a b. (a -> b) -> a -> b
$ (,)
		 (Text -> Natural -> (Text, Natural))
-> ReadP Text -> ReadP (Natural -> (Text, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
Text.pack (String -> Text) -> ReadP Char -> ReadP (String -> Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ReadP Char
Read.char Char
'-' ReadP (String -> Text) -> ReadP String -> ReadP Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> ReadP String
Read.munch1 Char -> Bool
Char.isAlpha)
		 ReadP (Natural -> (Text, Natural))
-> ReadP Natural -> ReadP (Text, Natural)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Natural
forall a. Read a => String -> a
Read.read (String -> Natural) -> ReadP String -> ReadP Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
Read.munch1 Char -> Bool
Char.isDigit ReadP Natural -> ReadP Natural -> ReadP Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Natural -> ReadP Natural
forall (m :: * -> *) a. Monad m => a -> m a
return Natural
0)
	Version -> ReadP Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version :: [Natural] -> [(Text, Natural)] -> Version
Version{[Natural]
[(Text, Natural)]
version_tags :: [(Text, Natural)]
version_branch :: [Natural]
version_tags :: [(Text, Natural)]
version_branch :: [Natural]
..}

-- ** Type 'V'
-- | Type-level representation of a specific 'Version'.
data V (branch::[Nat]) (tags::[(Symbol,Nat)])
-- | Like a normal 'reflect' but this one takes
-- its 'Version' from a type-level 'V'ersion
-- instead of a term-level 'Version'.
instance (VersionBranchVal branch, VersionTagsVal tags) => Reifies (V branch tags) Version where
	reflect :: proxy (V branch tags) -> Version
reflect proxy (V branch tags)
_ = Version :: [Natural] -> [(Text, Natural)] -> Version
Version
	 { version_branch :: [Natural]
version_branch = Proxy branch -> [Natural]
forall k (a :: k) (proxy :: k -> *).
VersionBranchVal a =>
proxy a -> [Natural]
versionBranchVal (Proxy branch
forall k (t :: k). Proxy t
Proxy @branch)
	 , version_tags :: [(Text, Natural)]
version_tags   = Proxy tags -> [(Text, Natural)]
forall k (a :: k) (proxy :: k -> *).
VersionTagsVal a =>
proxy a -> [(Text, Natural)]
versionTagsVal (Proxy tags
forall k (t :: k). Proxy t
Proxy @tags)
	 }

-- *** Class 'VersionBranchVal'
class VersionBranchVal a where
	versionBranchVal :: proxy a -> [Natural]
instance KnownNat h => VersionBranchVal '[h] where
	versionBranchVal :: proxy '[h] -> [Natural]
versionBranchVal proxy '[h]
_ = [Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy h
forall k (t :: k). Proxy t
Proxy @h))]
instance
 ( KnownNat h
 , KnownNat hh
 , VersionBranchVal (hh ':t)
 ) => VersionBranchVal (h ': hh ': t) where
	versionBranchVal :: proxy (h : hh : t) -> [Natural]
versionBranchVal proxy (h : hh : t)
_ =
		Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy h
forall k (t :: k). Proxy t
Proxy @h)) Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
:
		Proxy (hh : t) -> [Natural]
forall k (a :: k) (proxy :: k -> *).
VersionBranchVal a =>
proxy a -> [Natural]
versionBranchVal (Proxy (hh : t)
forall k (t :: k). Proxy t
Proxy @(hh ':t))

-- *** Class 'VersionTagsVal'
class VersionTagsVal a where
	versionTagsVal :: proxy a -> [(Text,Natural)]
instance VersionTagsVal '[] where
	versionTagsVal :: proxy '[] -> [(Text, Natural)]
versionTagsVal proxy '[]
_ = []
instance
 ( KnownSymbol s
 , KnownNat n
 , VersionTagsVal t
 ) => VersionTagsVal ('(s,n) ': t) where
	versionTagsVal :: proxy ('(s, n) : t) -> [(Text, Natural)]
versionTagsVal proxy ('(s, n) : t)
_ =
		( String -> Text
Text.pack (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s))
		, Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n))
		) (Text, Natural) -> [(Text, Natural)] -> [(Text, Natural)]
forall a. a -> [a] -> [a]
: Proxy t -> [(Text, Natural)]
forall k (a :: k) (proxy :: k -> *).
VersionTagsVal a =>
proxy a -> [(Text, Natural)]
versionTagsVal (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)