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

module Distribution.Types.ComponentName
  ( ComponentName (.., CFLibName, CExeName, CTestName, CBenchName)
  , showComponentName
  , componentNameRaw
  , componentNameStanza
  , componentNameString
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName

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

-- Libraries live in a separate namespace, so must distinguish
data ComponentName
  = CLibName LibraryName
  | CNotLibName NotLibComponentName
  deriving (ComponentName -> ComponentName -> Bool
(ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool) -> Eq ComponentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentName -> ComponentName -> Bool
== :: ComponentName -> ComponentName -> Bool
$c/= :: ComponentName -> ComponentName -> Bool
/= :: ComponentName -> ComponentName -> Bool
Eq, (forall x. ComponentName -> Rep ComponentName x)
-> (forall x. Rep ComponentName x -> ComponentName)
-> Generic ComponentName
forall x. Rep ComponentName x -> ComponentName
forall x. ComponentName -> Rep ComponentName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComponentName -> Rep ComponentName x
from :: forall x. ComponentName -> Rep ComponentName x
$cto :: forall x. Rep ComponentName x -> ComponentName
to :: forall x. Rep ComponentName x -> ComponentName
Generic, Eq ComponentName
Eq ComponentName =>
(ComponentName -> ComponentName -> Ordering)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> ComponentName)
-> (ComponentName -> ComponentName -> ComponentName)
-> Ord ComponentName
ComponentName -> ComponentName -> Bool
ComponentName -> ComponentName -> Ordering
ComponentName -> ComponentName -> ComponentName
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 :: ComponentName -> ComponentName -> Ordering
compare :: ComponentName -> ComponentName -> Ordering
$c< :: ComponentName -> ComponentName -> Bool
< :: ComponentName -> ComponentName -> Bool
$c<= :: ComponentName -> ComponentName -> Bool
<= :: ComponentName -> ComponentName -> Bool
$c> :: ComponentName -> ComponentName -> Bool
> :: ComponentName -> ComponentName -> Bool
$c>= :: ComponentName -> ComponentName -> Bool
>= :: ComponentName -> ComponentName -> Bool
$cmax :: ComponentName -> ComponentName -> ComponentName
max :: ComponentName -> ComponentName -> ComponentName
$cmin :: ComponentName -> ComponentName -> ComponentName
min :: ComponentName -> ComponentName -> ComponentName
Ord, ReadPrec [ComponentName]
ReadPrec ComponentName
Int -> ReadS ComponentName
ReadS [ComponentName]
(Int -> ReadS ComponentName)
-> ReadS [ComponentName]
-> ReadPrec ComponentName
-> ReadPrec [ComponentName]
-> Read ComponentName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ComponentName
readsPrec :: Int -> ReadS ComponentName
$creadList :: ReadS [ComponentName]
readList :: ReadS [ComponentName]
$creadPrec :: ReadPrec ComponentName
readPrec :: ReadPrec ComponentName
$creadListPrec :: ReadPrec [ComponentName]
readListPrec :: ReadPrec [ComponentName]
Read, Int -> ComponentName -> ShowS
[ComponentName] -> ShowS
ComponentName -> String
(Int -> ComponentName -> ShowS)
-> (ComponentName -> String)
-> ([ComponentName] -> ShowS)
-> Show ComponentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentName -> ShowS
showsPrec :: Int -> ComponentName -> ShowS
$cshow :: ComponentName -> String
show :: ComponentName -> String
$cshowList :: [ComponentName] -> ShowS
showList :: [ComponentName] -> ShowS
Show, Typeable)

data NotLibComponentName
  = CNLFLibName {NotLibComponentName -> UnqualComponentName
toCompName :: UnqualComponentName}
  | CNLExeName {toCompName :: UnqualComponentName}
  | CNLTestName {toCompName :: UnqualComponentName}
  | CNLBenchName {toCompName :: UnqualComponentName}
  deriving (NotLibComponentName -> NotLibComponentName -> Bool
(NotLibComponentName -> NotLibComponentName -> Bool)
-> (NotLibComponentName -> NotLibComponentName -> Bool)
-> Eq NotLibComponentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotLibComponentName -> NotLibComponentName -> Bool
== :: NotLibComponentName -> NotLibComponentName -> Bool
$c/= :: NotLibComponentName -> NotLibComponentName -> Bool
/= :: NotLibComponentName -> NotLibComponentName -> Bool
Eq, (forall x. NotLibComponentName -> Rep NotLibComponentName x)
-> (forall x. Rep NotLibComponentName x -> NotLibComponentName)
-> Generic NotLibComponentName
forall x. Rep NotLibComponentName x -> NotLibComponentName
forall x. NotLibComponentName -> Rep NotLibComponentName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NotLibComponentName -> Rep NotLibComponentName x
from :: forall x. NotLibComponentName -> Rep NotLibComponentName x
$cto :: forall x. Rep NotLibComponentName x -> NotLibComponentName
to :: forall x. Rep NotLibComponentName x -> NotLibComponentName
Generic, Eq NotLibComponentName
Eq NotLibComponentName =>
(NotLibComponentName -> NotLibComponentName -> Ordering)
-> (NotLibComponentName -> NotLibComponentName -> Bool)
-> (NotLibComponentName -> NotLibComponentName -> Bool)
-> (NotLibComponentName -> NotLibComponentName -> Bool)
-> (NotLibComponentName -> NotLibComponentName -> Bool)
-> (NotLibComponentName
    -> NotLibComponentName -> NotLibComponentName)
-> (NotLibComponentName
    -> NotLibComponentName -> NotLibComponentName)
-> Ord NotLibComponentName
NotLibComponentName -> NotLibComponentName -> Bool
NotLibComponentName -> NotLibComponentName -> Ordering
NotLibComponentName -> NotLibComponentName -> NotLibComponentName
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 :: NotLibComponentName -> NotLibComponentName -> Ordering
compare :: NotLibComponentName -> NotLibComponentName -> Ordering
$c< :: NotLibComponentName -> NotLibComponentName -> Bool
< :: NotLibComponentName -> NotLibComponentName -> Bool
$c<= :: NotLibComponentName -> NotLibComponentName -> Bool
<= :: NotLibComponentName -> NotLibComponentName -> Bool
$c> :: NotLibComponentName -> NotLibComponentName -> Bool
> :: NotLibComponentName -> NotLibComponentName -> Bool
$c>= :: NotLibComponentName -> NotLibComponentName -> Bool
>= :: NotLibComponentName -> NotLibComponentName -> Bool
$cmax :: NotLibComponentName -> NotLibComponentName -> NotLibComponentName
max :: NotLibComponentName -> NotLibComponentName -> NotLibComponentName
$cmin :: NotLibComponentName -> NotLibComponentName -> NotLibComponentName
min :: NotLibComponentName -> NotLibComponentName -> NotLibComponentName
Ord, ReadPrec [NotLibComponentName]
ReadPrec NotLibComponentName
Int -> ReadS NotLibComponentName
ReadS [NotLibComponentName]
(Int -> ReadS NotLibComponentName)
-> ReadS [NotLibComponentName]
-> ReadPrec NotLibComponentName
-> ReadPrec [NotLibComponentName]
-> Read NotLibComponentName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NotLibComponentName
readsPrec :: Int -> ReadS NotLibComponentName
$creadList :: ReadS [NotLibComponentName]
readList :: ReadS [NotLibComponentName]
$creadPrec :: ReadPrec NotLibComponentName
readPrec :: ReadPrec NotLibComponentName
$creadListPrec :: ReadPrec [NotLibComponentName]
readListPrec :: ReadPrec [NotLibComponentName]
Read, Int -> NotLibComponentName -> ShowS
[NotLibComponentName] -> ShowS
NotLibComponentName -> String
(Int -> NotLibComponentName -> ShowS)
-> (NotLibComponentName -> String)
-> ([NotLibComponentName] -> ShowS)
-> Show NotLibComponentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotLibComponentName -> ShowS
showsPrec :: Int -> NotLibComponentName -> ShowS
$cshow :: NotLibComponentName -> String
show :: NotLibComponentName -> String
$cshowList :: [NotLibComponentName] -> ShowS
showList :: [NotLibComponentName] -> ShowS
Show, Typeable)

pattern CFLibName :: UnqualComponentName -> ComponentName
pattern $mCFLibName :: forall {r}.
ComponentName -> (UnqualComponentName -> r) -> ((# #) -> r) -> r
$bCFLibName :: UnqualComponentName -> ComponentName
CFLibName n = CNotLibName (CNLFLibName n)

pattern CExeName :: UnqualComponentName -> ComponentName
pattern $mCExeName :: forall {r}.
ComponentName -> (UnqualComponentName -> r) -> ((# #) -> r) -> r
$bCExeName :: UnqualComponentName -> ComponentName
CExeName n = CNotLibName (CNLExeName n)

pattern CTestName :: UnqualComponentName -> ComponentName
pattern $mCTestName :: forall {r}.
ComponentName -> (UnqualComponentName -> r) -> ((# #) -> r) -> r
$bCTestName :: UnqualComponentName -> ComponentName
CTestName n = CNotLibName (CNLTestName n)

pattern CBenchName :: UnqualComponentName -> ComponentName
pattern $mCBenchName :: forall {r}.
ComponentName -> (UnqualComponentName -> r) -> ((# #) -> r) -> r
$bCBenchName :: UnqualComponentName -> ComponentName
CBenchName n = CNotLibName (CNLBenchName n)
{-# COMPLETE CLibName, CFLibName, CExeName, CTestName, CBenchName #-}

instance Binary NotLibComponentName
instance Structured NotLibComponentName

instance Binary ComponentName
instance Structured ComponentName

-- Build-target-ish syntax
instance Pretty ComponentName where
  pretty :: ComponentName -> Doc
pretty (CLibName LibraryName
lib) = LibraryName -> Doc
prettyLibraryNameComponent LibraryName
lib
  pretty (CFLibName UnqualComponentName
str) = String -> Doc
Disp.text String
"flib:" Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
str
  pretty (CExeName UnqualComponentName
str) = String -> Doc
Disp.text String
"exe:" Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
str
  pretty (CTestName UnqualComponentName
str) = String -> Doc
Disp.text String
"test:" Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
str
  pretty (CBenchName UnqualComponentName
str) = String -> Doc
Disp.text String
"bench:" Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
str

instance Parsec ComponentName where
  -- note: this works as lib/flib/... all start with different character!
  parsec :: forall (m :: * -> *). CabalParsing m => m ComponentName
parsec = m ComponentName
parseComposite m ComponentName -> m ComponentName -> m ComponentName
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ComponentName
parseLib
    where
      parseLib :: m ComponentName
parseLib = LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName) -> m LibraryName -> m ComponentName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LibraryName
forall (m :: * -> *). CabalParsing m => m LibraryName
parsecLibraryNameComponent
      parseComposite :: m ComponentName
parseComposite = do
        ctor <-
          [m (UnqualComponentName -> ComponentName)]
-> m (UnqualComponentName -> ComponentName)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
            [ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"flib:" m String
-> m (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnqualComponentName -> ComponentName
CFLibName
            , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"exe:" m String
-> m (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnqualComponentName -> ComponentName
CExeName
            , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"bench:" m String
-> m (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnqualComponentName -> ComponentName
CBenchName
            , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"test:" m String
-> m (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (UnqualComponentName -> ComponentName)
-> m (UnqualComponentName -> ComponentName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnqualComponentName -> ComponentName
CTestName
            ]
        ctor <$> parsec

showComponentName :: ComponentName -> String
showComponentName :: ComponentName -> String
showComponentName (CLibName LibraryName
lib) = LibraryName -> String
showLibraryName LibraryName
lib
showComponentName (CFLibName UnqualComponentName
name) = String
"foreign library '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
showComponentName (CExeName UnqualComponentName
name) = String
"executable '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
showComponentName (CTestName UnqualComponentName
name) = String
"test suite '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
showComponentName (CBenchName UnqualComponentName
name) = String
"benchmark '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"

componentNameRaw :: ComponentName -> String
componentNameRaw :: ComponentName -> String
componentNameRaw l :: ComponentName
l@(CLibName LibraryName
_) = ComponentName -> String
showComponentName ComponentName
l
componentNameRaw (CNotLibName NotLibComponentName
x) = UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ NotLibComponentName -> UnqualComponentName
toCompName NotLibComponentName
x

componentNameStanza :: ComponentName -> String
componentNameStanza :: ComponentName -> String
componentNameStanza (CLibName LibraryName
lib) = LibraryName -> String
libraryNameStanza LibraryName
lib
componentNameStanza (CFLibName UnqualComponentName
name) = String
"foreign-library " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name
componentNameStanza (CExeName UnqualComponentName
name) = String
"executable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name
componentNameStanza (CTestName UnqualComponentName
name) = String
"test-suite " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name
componentNameStanza (CBenchName UnqualComponentName
name) = String
"benchmark " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
name

-- | This gets the underlying unqualified component name. In fact, it is
-- guaranteed to uniquely identify a component, returning
-- @Nothing@ if the 'ComponentName' was for the public
-- library.
componentNameString :: ComponentName -> Maybe UnqualComponentName
componentNameString :: ComponentName -> Maybe UnqualComponentName
componentNameString (CLibName LibraryName
lib) = LibraryName -> Maybe UnqualComponentName
libraryNameString LibraryName
lib
componentNameString (CNotLibName NotLibComponentName
x) = UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just (UnqualComponentName -> Maybe UnqualComponentName)
-> UnqualComponentName -> Maybe UnqualComponentName
forall a b. (a -> b) -> a -> b
$ NotLibComponentName -> UnqualComponentName
toCompName NotLibComponentName
x