{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}


module Package.C.Type.Shared ( VersionBound (..)
                             , Dep (..)
                             ) where

import qualified Data.Text              as T
import           Dhall
import           Package.C.Type.Version

data VersionBound = Lower { VersionBound -> Version
lower :: Version }
                  | Upper { VersionBound -> Version
upper :: Version }
                  | LowerUpper { lower :: Version, upper :: Version }
                  | NoBound
                  deriving ((forall x. VersionBound -> Rep VersionBound x)
-> (forall x. Rep VersionBound x -> VersionBound)
-> Generic VersionBound
forall x. Rep VersionBound x -> VersionBound
forall x. VersionBound -> Rep VersionBound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionBound -> Rep VersionBound x
from :: forall x. VersionBound -> Rep VersionBound x
$cto :: forall x. Rep VersionBound x -> VersionBound
to :: forall x. Rep VersionBound x -> VersionBound
Generic, InputNormalizer -> Decoder VersionBound
(InputNormalizer -> Decoder VersionBound) -> FromDhall VersionBound
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder VersionBound
autoWith :: InputNormalizer -> Decoder VersionBound
FromDhall)

data Dep = Dep { Dep -> Text
name  :: T.Text
               , Dep -> VersionBound
bound :: VersionBound
               } deriving ((forall x. Dep -> Rep Dep x)
-> (forall x. Rep Dep x -> Dep) -> Generic Dep
forall x. Rep Dep x -> Dep
forall x. Dep -> Rep Dep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dep -> Rep Dep x
from :: forall x. Dep -> Rep Dep x
$cto :: forall x. Rep Dep x -> Dep
to :: forall x. Rep Dep x -> Dep
Generic, InputNormalizer -> Decoder Dep
(InputNormalizer -> Decoder Dep) -> FromDhall Dep
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder Dep
autoWith :: InputNormalizer -> Decoder Dep
FromDhall)