module CabalGild.Unstable.Type.TestedWith where

import qualified CabalGild.Unstable.Type.VersionRange as VersionRange
import qualified Distribution.Compat.CharParsing as Parse
import qualified Distribution.Compiler as Compiler
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Text.PrettyPrint as PrettyPrint

data TestedWith = MkTestedWith
  { TestedWith -> CompilerFlavor
compilerFlavor :: Compiler.CompilerFlavor,
    TestedWith -> Maybe VersionRange
versionRange :: Maybe VersionRange.VersionRange
  }
  deriving (TestedWith -> TestedWith -> Bool
(TestedWith -> TestedWith -> Bool)
-> (TestedWith -> TestedWith -> Bool) -> Eq TestedWith
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestedWith -> TestedWith -> Bool
== :: TestedWith -> TestedWith -> Bool
$c/= :: TestedWith -> TestedWith -> Bool
/= :: TestedWith -> TestedWith -> Bool
Eq, Eq TestedWith
Eq TestedWith =>
(TestedWith -> TestedWith -> Ordering)
-> (TestedWith -> TestedWith -> Bool)
-> (TestedWith -> TestedWith -> Bool)
-> (TestedWith -> TestedWith -> Bool)
-> (TestedWith -> TestedWith -> Bool)
-> (TestedWith -> TestedWith -> TestedWith)
-> (TestedWith -> TestedWith -> TestedWith)
-> Ord TestedWith
TestedWith -> TestedWith -> Bool
TestedWith -> TestedWith -> Ordering
TestedWith -> TestedWith -> TestedWith
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 :: TestedWith -> TestedWith -> Ordering
compare :: TestedWith -> TestedWith -> Ordering
$c< :: TestedWith -> TestedWith -> Bool
< :: TestedWith -> TestedWith -> Bool
$c<= :: TestedWith -> TestedWith -> Bool
<= :: TestedWith -> TestedWith -> Bool
$c> :: TestedWith -> TestedWith -> Bool
> :: TestedWith -> TestedWith -> Bool
$c>= :: TestedWith -> TestedWith -> Bool
>= :: TestedWith -> TestedWith -> Bool
$cmax :: TestedWith -> TestedWith -> TestedWith
max :: TestedWith -> TestedWith -> TestedWith
$cmin :: TestedWith -> TestedWith -> TestedWith
min :: TestedWith -> TestedWith -> TestedWith
Ord, Int -> TestedWith -> ShowS
[TestedWith] -> ShowS
TestedWith -> String
(Int -> TestedWith -> ShowS)
-> (TestedWith -> String)
-> ([TestedWith] -> ShowS)
-> Show TestedWith
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestedWith -> ShowS
showsPrec :: Int -> TestedWith -> ShowS
$cshow :: TestedWith -> String
show :: TestedWith -> String
$cshowList :: [TestedWith] -> ShowS
showList :: [TestedWith] -> ShowS
Show)

instance Parsec.Parsec TestedWith where
  parsec :: forall (m :: * -> *). CabalParsing m => m TestedWith
parsec =
    CompilerFlavor -> Maybe VersionRange -> TestedWith
MkTestedWith
      (CompilerFlavor -> Maybe VersionRange -> TestedWith)
-> m CompilerFlavor -> m (Maybe VersionRange -> TestedWith)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CompilerFlavor
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m CompilerFlavor
Parsec.parsec
      m (Maybe VersionRange -> TestedWith)
-> m () -> m (Maybe VersionRange -> TestedWith)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces
      m (Maybe VersionRange -> TestedWith)
-> m (Maybe VersionRange) -> m TestedWith
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m VersionRange -> m (Maybe VersionRange)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parse.optional m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m VersionRange
Parsec.parsec

instance Pretty.Pretty TestedWith where
  pretty :: TestedWith -> Doc
pretty TestedWith
x =
    [Doc] -> Doc
PrettyPrint.hsep
      [ CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty (CompilerFlavor -> Doc) -> CompilerFlavor -> Doc
forall a b. (a -> b) -> a -> b
$ TestedWith -> CompilerFlavor
compilerFlavor TestedWith
x,
        (VersionRange -> Doc) -> Maybe VersionRange -> Doc
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VersionRange -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty (Maybe VersionRange -> Doc) -> Maybe VersionRange -> Doc
forall a b. (a -> b) -> a -> b
$ TestedWith -> Maybe VersionRange
versionRange TestedWith
x
      ]