-- | The ModuleName type
module GHC.Unit.Module.Name
    ( ModuleName
    , pprModuleName
    , moduleNameFS
    , moduleNameString
    , moduleNameSlashes, moduleNameColons
    , mkModuleName
    , mkModuleNameFS
    , stableModuleNameCmp
    , parseModuleName
    )
where

import GHC.Prelude

import GHC.Utils.Outputable
import GHC.Types.Unique
import GHC.Data.FastString
import GHC.Utils.Binary
import GHC.Utils.Misc

import Control.DeepSeq
import Data.Data
import System.FilePath

import qualified Text.ParserCombinators.ReadP as Parse
import Text.ParserCombinators.ReadP (ReadP)
import Data.Char (isAlphaNum)

-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
newtype ModuleName = ModuleName FastString

instance Uniquable ModuleName where
  getUnique :: ModuleName -> Unique
getUnique (ModuleName FastString
nm) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
nm

instance Eq ModuleName where
  ModuleName
nm1 == :: ModuleName -> ModuleName -> Bool
== ModuleName
nm2 = ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
nm1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
nm2

instance Ord ModuleName where
  ModuleName
nm1 compare :: ModuleName -> ModuleName -> Ordering
`compare` ModuleName
nm2 = ModuleName -> ModuleName -> Ordering
stableModuleNameCmp ModuleName
nm1 ModuleName
nm2

instance Outputable ModuleName where
  ppr :: ModuleName -> SDoc
ppr = ModuleName -> SDoc
pprModuleName

instance Binary ModuleName where
  put_ :: BinHandle -> ModuleName -> IO ()
put_ BinHandle
bh (ModuleName FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO ModuleName
get BinHandle
bh = do FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; ModuleName -> IO ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> ModuleName
ModuleName FastString
fs)

instance Data ModuleName where
  -- don't traverse?
  toConstr :: ModuleName -> Constr
toConstr ModuleName
_   = String -> Constr
abstractConstr String
"ModuleName"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c ModuleName
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: ModuleName -> DataType
dataTypeOf ModuleName
_ = String -> DataType
mkNoRepType String
"ModuleName"

instance NFData ModuleName where
  rnf :: ModuleName -> ()
rnf ModuleName
x = ModuleName
x ModuleName -> () -> ()
`seq` ()

stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- ^ Compares module names lexically, rather than by their 'Unique's
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
stableModuleNameCmp ModuleName
n1 ModuleName
n2 = ModuleName -> FastString
moduleNameFS ModuleName
n1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ModuleName -> FastString
moduleNameFS ModuleName
n2

pprModuleName :: ModuleName -> SDoc
pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName FastString
nm) =
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
    if PprStyle -> Bool
codeStyle PprStyle
sty
        then FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS FastString
nm)
        else FastString -> SDoc
ftext FastString
nm

moduleNameFS :: ModuleName -> FastString
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName FastString
mod) = FastString
mod

moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> String
moduleNameString (ModuleName FastString
mod) = FastString -> String
unpackFS FastString
mod

mkModuleName :: String -> ModuleName
mkModuleName :: String -> ModuleName
mkModuleName String
s = FastString -> ModuleName
ModuleName (String -> FastString
mkFastString String
s)

mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS FastString
s = FastString -> ModuleName
ModuleName FastString
s

-- |Returns the string version of the module name, with dots replaced by slashes.
--
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = String -> String
dots_to_slashes (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString
  where dots_to_slashes :: String -> String
dots_to_slashes = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
pathSeparator else Char
c)

-- |Returns the string version of the module name, with dots replaced by colons.
--
moduleNameColons :: ModuleName -> String
moduleNameColons :: ModuleName -> String
moduleNameColons = String -> String
dots_to_colons (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString
  where dots_to_colons :: String -> String
dots_to_colons = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
':' else Char
c)

parseModuleName :: ReadP ModuleName
parseModuleName :: ReadP ModuleName
parseModuleName = (String -> ModuleName) -> ReadP String -> ReadP ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ModuleName
mkModuleName
                (ReadP String -> ReadP ModuleName)
-> ReadP String -> ReadP ModuleName
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
Parse.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_.")