module CabalGild.Unstable.Type.ForeignLibOption where

import qualified Data.Ord as Ord
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Distribution.Types.ForeignLibOption as ForeignLibOption

-- | This type exists to provide an 'Ord' instance for
-- 'ForeignLibOption.ForeignLibOption', which was added in
-- @Cabal-syntax-3.10.1.0@.
newtype ForeignLibOption = ForeignLibOption
  { ForeignLibOption -> ForeignLibOption
unwrap :: ForeignLibOption.ForeignLibOption
  }
  deriving (ForeignLibOption -> ForeignLibOption -> Bool
(ForeignLibOption -> ForeignLibOption -> Bool)
-> (ForeignLibOption -> ForeignLibOption -> Bool)
-> Eq ForeignLibOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignLibOption -> ForeignLibOption -> Bool
== :: ForeignLibOption -> ForeignLibOption -> Bool
$c/= :: ForeignLibOption -> ForeignLibOption -> Bool
/= :: ForeignLibOption -> ForeignLibOption -> Bool
Eq, Int -> ForeignLibOption -> ShowS
[ForeignLibOption] -> ShowS
ForeignLibOption -> String
(Int -> ForeignLibOption -> ShowS)
-> (ForeignLibOption -> String)
-> ([ForeignLibOption] -> ShowS)
-> Show ForeignLibOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForeignLibOption -> ShowS
showsPrec :: Int -> ForeignLibOption -> ShowS
$cshow :: ForeignLibOption -> String
show :: ForeignLibOption -> String
$cshowList :: [ForeignLibOption] -> ShowS
showList :: [ForeignLibOption] -> ShowS
Show)

instance Ord ForeignLibOption where
  compare :: ForeignLibOption -> ForeignLibOption -> Ordering
compare = (ForeignLibOption -> String)
-> ForeignLibOption -> ForeignLibOption -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing ForeignLibOption -> String
forall a. Pretty a => a -> String
Pretty.prettyShow

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

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