module Voting.Protocol.Version where

import Data.Foldable (any)
import Data.List (List)
import Data.Eq ((==))

import Voting.Protocol.Arithmetic

-- * Type 'Version'
-- | Version of the Helios-C protocol.
data Version = Version
 { version_branch :: List Natural
 , version_tags   :: List { tag :: String, tagNum :: Natural }
 }
{-
instance IsString Version where
	fromString = fromJust . readVersion
instance Show Version where
	showsPrec _p Version{..} =
		List.foldr (.) id
		 (List.intersperse (showChar '.') $
			shows <$> version_branch) .
		List.foldr (.) id
		 ((\(t,n) -> showChar '-' . showString (Text.unpack t) .
			if n > 0 then shows n else id)
		 <$> version_tags)
instance ToJSON Version where
	toJSON     = toJSON     . show
	toEncoding = toEncoding . show
instance FromJSON Version where
	parseJSON (JSON.String s)
	 | Just v <- readVersion (Text.unpack s)
	 = return v
	parseJSON json = JSON.typeMismatch "Version" json
-}

hasVersionTag :: Version -> String -> Boolean
hasVersionTag (Version v) tag = any (\{tag:t} -> t == tag) v.version_tags
{-
-- ** Type 'ExperimentalVersion'
type ExperimentalVersion = V [1,6] '[ '(VersionTagQuicker,0)]
experimentalVersion :: Version
experimentalVersion = stableVersion{version_tags = [(versionTagQuicker,0)]}

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

-- ** Type 'VersionTagQuicker'
type VersionTagQuicker = "quicker"
-}
versionTagQuicker :: String
versionTagQuicker = "quicker"
{-
readVersion :: String -> Maybe Version
readVersion = parseReadP $ do
	version_branch <- Read.sepBy1
	 (Read.read <$> Read.munch1 Char.isDigit)
	 (Read.char '.')
	version_tags <- Read.many $ (,)
		 <$> (Text.pack <$ Read.char '-' <*> Read.munch1 Char.isAlpha)
		 <*> (Read.read <$> Read.munch1 Char.isDigit <|> return 0)
	return Version{..}

-- ** 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 _ = Version
	 { version_branch = versionBranchVal (Proxy @branch)
	 , version_tags   = versionTagsVal (Proxy @tags)
	 }

-- *** Class 'VersionBranchVal'
class VersionBranchVal a where
	versionBranchVal :: proxy a -> [Natural]
instance KnownNat h => VersionBranchVal '[h] where
	versionBranchVal _ = [fromIntegral (natVal (Proxy @h))]
instance
 ( KnownNat h
 , KnownNat hh
 , VersionBranchVal (hh ':t)
 ) => VersionBranchVal (h ': hh ': t) where
	versionBranchVal _ =
		fromIntegral (natVal (Proxy @h)) :
		versionBranchVal (Proxy @(hh ':t))

-- *** Class 'VersionTagsVal'
class VersionTagsVal a where
	versionTagsVal :: proxy a -> [(Text,Natural)]
instance VersionTagsVal '[] where
	versionTagsVal _ = []
instance
 ( KnownSymbol s
 , KnownNat n
 , VersionTagsVal t
 ) => VersionTagsVal ('(s,n) ': t) where
	versionTagsVal _ =
		( Text.pack (symbolVal (Proxy @s))
		, fromIntegral (natVal (Proxy @n))
		) : versionTagsVal (Proxy :: Proxy t)
-}