module GHC.Toolchain.Library
  ( Library(..)
  )
  where

import System.FilePath
import GHC.Toolchain.Prelude

data Library = Library { Library -> String
libName :: String
                       , Library -> Maybe String
includePath :: Maybe FilePath
                       , Library -> Maybe String
libraryPath :: Maybe FilePath
                       }
    deriving (ReadPrec [Library]
ReadPrec Library
Int -> ReadS Library
ReadS [Library]
(Int -> ReadS Library)
-> ReadS [Library]
-> ReadPrec Library
-> ReadPrec [Library]
-> Read Library
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Library
readsPrec :: Int -> ReadS Library
$creadList :: ReadS [Library]
readList :: ReadS [Library]
$creadPrec :: ReadPrec Library
readPrec :: ReadPrec Library
$creadListPrec :: ReadPrec [Library]
readListPrec :: ReadPrec [Library]
Read, Library -> Library -> Bool
(Library -> Library -> Bool)
-> (Library -> Library -> Bool) -> Eq Library
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Library -> Library -> Bool
== :: Library -> Library -> Bool
$c/= :: Library -> Library -> Bool
/= :: Library -> Library -> Bool
Eq, Eq Library
Eq Library =>
(Library -> Library -> Ordering)
-> (Library -> Library -> Bool)
-> (Library -> Library -> Bool)
-> (Library -> Library -> Bool)
-> (Library -> Library -> Bool)
-> (Library -> Library -> Library)
-> (Library -> Library -> Library)
-> Ord Library
Library -> Library -> Bool
Library -> Library -> Ordering
Library -> Library -> Library
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 :: Library -> Library -> Ordering
compare :: Library -> Library -> Ordering
$c< :: Library -> Library -> Bool
< :: Library -> Library -> Bool
$c<= :: Library -> Library -> Bool
<= :: Library -> Library -> Bool
$c> :: Library -> Library -> Bool
> :: Library -> Library -> Bool
$c>= :: Library -> Library -> Bool
>= :: Library -> Library -> Bool
$cmax :: Library -> Library -> Library
max :: Library -> Library -> Library
$cmin :: Library -> Library -> Library
min :: Library -> Library -> Library
Ord)

instance Show Library where
  -- Normalise filepaths before showing to aid with diffing the target files.
  show :: Library -> String
show (Library String
n Maybe String
i Maybe String
l) = [String] -> String
unwords
    [ String
"Library { libName = ", ShowS
forall a. Show a => a -> String
show String
n
    , String
", includePath = ", Maybe String -> String
forall a. Show a => a -> String
show (ShowS
normalise ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
i)
    , String
", libraryPath =", Maybe String -> String
forall a. Show a => a -> String
show (ShowS
normalise ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
l)
    , String
"}"]