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 ]