{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.ForeignLibType(
    ForeignLibType(..),
    knownForeignLibTypes,
    foreignLibTypeIsShared,
) where

import Prelude ()
import Distribution.Compat.Prelude
import Distribution.PackageDescription.Utils

import Distribution.Pretty
import Distribution.Parsec

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp

-- | What kind of foreign library is to be built?
data ForeignLibType =
      -- | A native shared library (@.so@ on Linux, @.dylib@ on OSX, or
      -- @.dll@ on Windows).
      ForeignLibNativeShared
      -- | A native static library (not currently supported.)
    | ForeignLibNativeStatic
      -- TODO: Maybe this should record a string?
    | ForeignLibTypeUnknown
    deriving ((forall x. ForeignLibType -> Rep ForeignLibType x)
-> (forall x. Rep ForeignLibType x -> ForeignLibType)
-> Generic ForeignLibType
forall x. Rep ForeignLibType x -> ForeignLibType
forall x. ForeignLibType -> Rep ForeignLibType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForeignLibType x -> ForeignLibType
$cfrom :: forall x. ForeignLibType -> Rep ForeignLibType x
Generic, Int -> ForeignLibType -> ShowS
[ForeignLibType] -> ShowS
ForeignLibType -> String
(Int -> ForeignLibType -> ShowS)
-> (ForeignLibType -> String)
-> ([ForeignLibType] -> ShowS)
-> Show ForeignLibType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignLibType] -> ShowS
$cshowList :: [ForeignLibType] -> ShowS
show :: ForeignLibType -> String
$cshow :: ForeignLibType -> String
showsPrec :: Int -> ForeignLibType -> ShowS
$cshowsPrec :: Int -> ForeignLibType -> ShowS
Show, ReadPrec [ForeignLibType]
ReadPrec ForeignLibType
Int -> ReadS ForeignLibType
ReadS [ForeignLibType]
(Int -> ReadS ForeignLibType)
-> ReadS [ForeignLibType]
-> ReadPrec ForeignLibType
-> ReadPrec [ForeignLibType]
-> Read ForeignLibType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ForeignLibType]
$creadListPrec :: ReadPrec [ForeignLibType]
readPrec :: ReadPrec ForeignLibType
$creadPrec :: ReadPrec ForeignLibType
readList :: ReadS [ForeignLibType]
$creadList :: ReadS [ForeignLibType]
readsPrec :: Int -> ReadS ForeignLibType
$creadsPrec :: Int -> ReadS ForeignLibType
Read, ForeignLibType -> ForeignLibType -> Bool
(ForeignLibType -> ForeignLibType -> Bool)
-> (ForeignLibType -> ForeignLibType -> Bool) -> Eq ForeignLibType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignLibType -> ForeignLibType -> Bool
$c/= :: ForeignLibType -> ForeignLibType -> Bool
== :: ForeignLibType -> ForeignLibType -> Bool
$c== :: ForeignLibType -> ForeignLibType -> Bool
Eq, Typeable, Typeable ForeignLibType
DataType
Constr
Typeable ForeignLibType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ForeignLibType -> c ForeignLibType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ForeignLibType)
-> (ForeignLibType -> Constr)
-> (ForeignLibType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ForeignLibType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ForeignLibType))
-> ((forall b. Data b => b -> b)
    -> ForeignLibType -> ForeignLibType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ForeignLibType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ForeignLibType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ForeignLibType -> m ForeignLibType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ForeignLibType -> m ForeignLibType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ForeignLibType -> m ForeignLibType)
-> Data ForeignLibType
ForeignLibType -> DataType
ForeignLibType -> Constr
(forall b. Data b => b -> b) -> ForeignLibType -> ForeignLibType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLibType -> c ForeignLibType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLibType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ForeignLibType -> u
forall u. (forall d. Data d => d -> u) -> ForeignLibType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLibType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLibType -> c ForeignLibType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForeignLibType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForeignLibType)
$cForeignLibTypeUnknown :: Constr
$cForeignLibNativeStatic :: Constr
$cForeignLibNativeShared :: Constr
$tForeignLibType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
gmapMp :: (forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
gmapM :: (forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForeignLibType -> m ForeignLibType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ForeignLibType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ForeignLibType -> u
gmapQ :: (forall d. Data d => d -> u) -> ForeignLibType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ForeignLibType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLibType -> r
gmapT :: (forall b. Data b => b -> b) -> ForeignLibType -> ForeignLibType
$cgmapT :: (forall b. Data b => b -> b) -> ForeignLibType -> ForeignLibType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForeignLibType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForeignLibType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ForeignLibType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForeignLibType)
dataTypeOf :: ForeignLibType -> DataType
$cdataTypeOf :: ForeignLibType -> DataType
toConstr :: ForeignLibType -> Constr
$ctoConstr :: ForeignLibType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLibType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLibType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLibType -> c ForeignLibType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLibType -> c ForeignLibType
$cp1Data :: Typeable ForeignLibType
Data)

instance Pretty ForeignLibType where
  pretty :: ForeignLibType -> Doc
pretty ForeignLibType
ForeignLibNativeShared = String -> Doc
Disp.text String
"native-shared"
  pretty ForeignLibType
ForeignLibNativeStatic = String -> Doc
Disp.text String
"native-static"
  pretty ForeignLibType
ForeignLibTypeUnknown  = String -> Doc
Disp.text String
"unknown"

instance Parsec ForeignLibType where
  parsec :: m ForeignLibType
parsec = do
    String
name <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
    ForeignLibType -> m ForeignLibType
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignLibType -> m ForeignLibType)
-> ForeignLibType -> m ForeignLibType
forall a b. (a -> b) -> a -> b
$ case String
name of
      String
"native-shared" -> ForeignLibType
ForeignLibNativeShared
      String
"native-static" -> ForeignLibType
ForeignLibNativeStatic
      String
_               -> ForeignLibType
ForeignLibTypeUnknown

instance Binary ForeignLibType
instance Structured ForeignLibType
instance NFData ForeignLibType where rnf :: ForeignLibType -> ()
rnf = ForeignLibType -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance Semigroup ForeignLibType where
  ForeignLibType
ForeignLibTypeUnknown <> :: ForeignLibType -> ForeignLibType -> ForeignLibType
<> ForeignLibType
b = ForeignLibType
b
  ForeignLibType
a <> ForeignLibType
ForeignLibTypeUnknown = ForeignLibType
a
  ForeignLibType
_ <> ForeignLibType
_ = String -> ForeignLibType
forall a. HasCallStack => String -> a
error String
"Ambiguous foreign library type"

instance Monoid ForeignLibType where
  mempty :: ForeignLibType
mempty = ForeignLibType
ForeignLibTypeUnknown
  mappend :: ForeignLibType -> ForeignLibType -> ForeignLibType
mappend = ForeignLibType -> ForeignLibType -> ForeignLibType
forall a. Semigroup a => a -> a -> a
(<>)

knownForeignLibTypes :: [ForeignLibType]
knownForeignLibTypes :: [ForeignLibType]
knownForeignLibTypes = [
      ForeignLibType
ForeignLibNativeShared
    , ForeignLibType
ForeignLibNativeStatic
    ]

foreignLibTypeIsShared :: ForeignLibType -> Bool
foreignLibTypeIsShared :: ForeignLibType -> Bool
foreignLibTypeIsShared ForeignLibType
t =
    case ForeignLibType
t of
      ForeignLibType
ForeignLibNativeShared -> Bool
True
      ForeignLibType
ForeignLibNativeStatic -> Bool
False
      ForeignLibType
ForeignLibTypeUnknown  -> String -> Bool
forall a. String -> a
cabalBug String
"Unknown foreign library type"