module CabalGild.Unstable.Type.TestedWith where

import qualified CabalGild.Unstable.Type.VersionRange as VersionRange
import qualified Data.Ord as Ord
import qualified Distribution.FieldGrammar.Newtypes as Newtypes
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty

-- | This type exists to provide an 'Ord' instance for 'Newtypes.TestedWith',
-- which was added in @Cabal-syntax-3.10.1.0@.
newtype TestedWith = TestedWith
  { TestedWith -> TestedWith
unwrap :: Newtypes.TestedWith
  }

instance Eq TestedWith where
  TestedWith
x == :: TestedWith -> TestedWith -> Bool
== TestedWith
y = TestedWith -> TestedWith -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TestedWith
x TestedWith
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord TestedWith where
  compare :: TestedWith -> TestedWith -> Ordering
compare =
    (TestedWith -> (CompilerFlavor, VersionRange Version))
-> TestedWith -> TestedWith -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing ((TestedWith -> (CompilerFlavor, VersionRange Version))
 -> TestedWith -> TestedWith -> Ordering)
-> (TestedWith -> (CompilerFlavor, VersionRange Version))
-> TestedWith
-> TestedWith
-> Ordering
forall a b. (a -> b) -> a -> b
$
      (VersionRange -> VersionRange Version)
-> (CompilerFlavor, VersionRange)
-> (CompilerFlavor, VersionRange Version)
forall a b. (a -> b) -> (CompilerFlavor, a) -> (CompilerFlavor, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionRange -> VersionRange Version
VersionRange.fromVersionRange
        ((CompilerFlavor, VersionRange)
 -> (CompilerFlavor, VersionRange Version))
-> (TestedWith -> (CompilerFlavor, VersionRange))
-> TestedWith
-> (CompilerFlavor, VersionRange Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestedWith -> (CompilerFlavor, VersionRange)
Newtypes.getTestedWith
        (TestedWith -> (CompilerFlavor, VersionRange))
-> (TestedWith -> TestedWith)
-> TestedWith
-> (CompilerFlavor, VersionRange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestedWith -> TestedWith
unwrap

instance Parsec.Parsec TestedWith where
  parsec :: forall (m :: * -> *). CabalParsing m => m TestedWith
parsec = TestedWith -> TestedWith
TestedWith (TestedWith -> TestedWith) -> m TestedWith -> m TestedWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TestedWith
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m TestedWith
Parsec.parsec

instance Pretty.Pretty TestedWith where
  pretty :: TestedWith -> Doc
pretty = TestedWith -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty (TestedWith -> Doc)
-> (TestedWith -> TestedWith) -> TestedWith -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestedWith -> TestedWith
unwrap

instance Show TestedWith where
  show :: TestedWith -> String
show = (CompilerFlavor, VersionRange) -> String
forall a. Show a => a -> String
show ((CompilerFlavor, VersionRange) -> String)
-> (TestedWith -> (CompilerFlavor, VersionRange))
-> TestedWith
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestedWith -> (CompilerFlavor, VersionRange)
Newtypes.getTestedWith (TestedWith -> (CompilerFlavor, VersionRange))
-> (TestedWith -> TestedWith)
-> TestedWith
-> (CompilerFlavor, VersionRange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestedWith -> TestedWith
unwrap