{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.ModuleName
-- Copyright   :  Duncan Coutts 2008
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Data type for Haskell module names.

module Distribution.ModuleName (
        ModuleName,
        fromString,
        fromComponents,
        components,
        toFilePath,
        main,
        -- * Internal
        validModuleComponent,
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)
import System.FilePath              (pathSeparator)

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

-- | A valid Haskell module name.
--
newtype ModuleName = ModuleName ShortText
  deriving (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, (forall x. ModuleName -> Rep ModuleName x)
-> (forall x. Rep ModuleName x -> ModuleName) -> Generic ModuleName
forall x. Rep ModuleName x -> ModuleName
forall x. ModuleName -> Rep ModuleName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleName x -> ModuleName
$cfrom :: forall x. ModuleName -> Rep ModuleName x
Generic, Eq ModuleName
Eq ModuleName
-> (ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
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
min :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
$cp1Ord :: Eq ModuleName
Ord, ReadPrec [ModuleName]
ReadPrec ModuleName
Int -> ReadS ModuleName
ReadS [ModuleName]
(Int -> ReadS ModuleName)
-> ReadS [ModuleName]
-> ReadPrec ModuleName
-> ReadPrec [ModuleName]
-> Read ModuleName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModuleName]
$creadListPrec :: ReadPrec [ModuleName]
readPrec :: ReadPrec ModuleName
$creadPrec :: ReadPrec ModuleName
readList :: ReadS [ModuleName]
$creadList :: ReadS [ModuleName]
readsPrec :: Int -> ReadS ModuleName
$creadsPrec :: Int -> ReadS ModuleName
Read, Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> String
(Int -> ModuleName -> ShowS)
-> (ModuleName -> String)
-> ([ModuleName] -> ShowS)
-> Show ModuleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> String
$cshow :: ModuleName -> String
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show, Typeable, Typeable ModuleName
DataType
Constr
Typeable ModuleName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ModuleName -> c ModuleName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModuleName)
-> (ModuleName -> Constr)
-> (ModuleName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModuleName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ModuleName))
-> ((forall b. Data b => b -> b) -> ModuleName -> ModuleName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModuleName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModuleName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ModuleName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModuleName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName)
-> Data ModuleName
ModuleName -> DataType
ModuleName -> Constr
(forall b. Data b => b -> b) -> ModuleName -> ModuleName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
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) -> ModuleName -> u
forall u. (forall d. Data d => d -> u) -> ModuleName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
$cModuleName :: Constr
$tModuleName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapMp :: (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapM :: (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapQi :: Int -> (forall d. Data d => d -> u) -> ModuleName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModuleName -> u
gmapQ :: (forall d. Data d => d -> u) -> ModuleName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
gmapT :: (forall b. Data b => b -> b) -> ModuleName -> ModuleName
$cgmapT :: (forall b. Data b => b -> b) -> ModuleName -> ModuleName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ModuleName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleName)
dataTypeOf :: ModuleName -> DataType
$cdataTypeOf :: ModuleName -> DataType
toConstr :: ModuleName -> Constr
$ctoConstr :: ModuleName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
$cp1Data :: Typeable ModuleName
Data)

unModuleName :: ModuleName -> String
unModuleName :: ModuleName -> String
unModuleName (ModuleName ShortText
s) = ShortText -> String
fromShortText ShortText
s

instance Binary ModuleName
instance Structured ModuleName

instance NFData ModuleName where
    rnf :: ModuleName -> ()
rnf (ModuleName ShortText
ms) = ShortText -> ()
forall a. NFData a => a -> ()
rnf ShortText
ms

instance Pretty ModuleName where
  pretty :: ModuleName -> Doc
pretty = String -> Doc
Disp.text (String -> Doc) -> (ModuleName -> String) -> ModuleName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
unModuleName

instance Parsec ModuleName where
    parsec :: m ModuleName
parsec = m ModuleName
forall (m :: * -> *). CabalParsing m => m ModuleName
parsecModuleName

parsecModuleName :: forall m. CabalParsing m => m ModuleName
parsecModuleName :: m ModuleName
parsecModuleName = DList Char -> m ModuleName
state0 DList Char
forall a. DList a
DList.empty where
    upper :: m Char
    !upper :: m Char
upper = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isUpper

    ch :: m Char
    !ch :: m Char
ch = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c -> Char -> Bool
validModuleChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')

    alt :: m ModuleName -> m ModuleName -> m ModuleName
    !alt :: m ModuleName -> m ModuleName -> m ModuleName
alt = m ModuleName -> m ModuleName -> m ModuleName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

    state0 :: DList.DList Char -> m ModuleName
    state0 :: DList Char -> m ModuleName
state0 DList Char
acc = do
        Char
c <- m Char
upper
        DList Char -> m ModuleName
state1 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)

    state1 :: DList.DList Char -> m ModuleName
    state1 :: DList Char -> m ModuleName
state1 DList Char
acc = DList Char -> m ModuleName
state1' DList Char
acc m ModuleName -> m ModuleName -> m ModuleName
`alt` ModuleName -> m ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ModuleName
forall a. IsString a => String -> a
fromString (DList Char -> String
forall a. DList a -> [a]
DList.toList DList Char
acc))

    state1' :: DList.DList Char -> m ModuleName
    state1' :: DList Char -> m ModuleName
state1' DList Char
acc = do
        Char
c <- m Char
ch
        case Char
c of
            Char
'.' -> DList Char -> m ModuleName
state0 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)
            Char
_   -> DList Char -> m ModuleName
state1 (DList Char -> Char -> DList Char
forall a. DList a -> a -> DList a
DList.snoc DList Char
acc Char
c)

validModuleChar :: Char -> Bool
validModuleChar :: Char -> Bool
validModuleChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

validModuleComponent :: String -> Bool
validModuleComponent :: String -> Bool
validModuleComponent []     = Bool
False
validModuleComponent (Char
c:String
cs) = Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validModuleChar String
cs

-- | Construct a 'ModuleName' from a valid module name 'String'.
--
-- This is just a convenience function intended for valid module strings. It is
-- an error if it is used with a string that is not a valid module name. If you
-- are parsing user input then use 'Distribution.Text.simpleParse' instead.
--
instance IsString ModuleName where
    fromString :: String -> ModuleName
fromString = ShortText -> ModuleName
ModuleName (ShortText -> ModuleName)
-> (String -> ShortText) -> String -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
toShortText

-- | Construct a 'ModuleName' from valid module components, i.e. parts
-- separated by dots.
fromComponents :: [String] -> ModuleName
fromComponents :: [String] -> ModuleName
fromComponents [String]
comps = String -> ModuleName
forall a. IsString a => String -> a
fromString (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
comps)
{-# DEPRECATED fromComponents "Exists for cabal-install only" #-}

-- | The module name @Main@.
--
main :: ModuleName
main :: ModuleName
main = ShortText -> ModuleName
ModuleName (String -> ShortText
forall a. IsString a => String -> a
fromString String
"Main")

-- | The individual components of a hierarchical module name. For example
--
-- > components (fromString "A.B.C") = ["A", "B", "C"]
--
components :: ModuleName -> [String]
components :: ModuleName -> [String]
components ModuleName
mn = String -> [String]
split (ModuleName -> String
unModuleName ModuleName
mn)
  where
    split :: String -> [String]
split String
cs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') String
cs of
      (String
chunk,[])     -> String
chunk String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
      (String
chunk,Char
_:String
rest) -> String
chunk String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split String
rest

-- | Convert a module name to a file path, but without any file extension.
-- For example:
--
-- > toFilePath (fromString "A.B.C") = "A/B/C"
--
toFilePath :: ModuleName -> FilePath
toFilePath :: ModuleName -> String
toFilePath = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f ShowS -> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
unModuleName where
    f :: Char -> Char
f Char
'.' = Char
pathSeparator
    f Char
c   = Char
c