{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.ModuleName (
ModuleName,
fromString,
components,
toFilePath,
main,
simple,
) where
import Distribution.Text
import Distribution.Compat.Binary
import qualified Distribution.Compat.ReadP as Parse
import qualified Data.Char as Char
( isAlphaNum, isUpper )
import Data.Data (Data)
import Data.Typeable (Typeable)
import qualified Text.PrettyPrint as Disp
import Data.List
( intercalate, intersperse )
import GHC.Generics (Generic)
import System.FilePath
( pathSeparator )
newtype ModuleName = ModuleName [String]
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
instance Binary ModuleName
instance Text ModuleName where
disp (ModuleName ms) =
Disp.hcat (intersperse (Disp.char '.') (map Disp.text ms))
parse = do
ms <- Parse.sepBy1 component (Parse.char '.')
return (ModuleName ms)
where
component = do
c <- Parse.satisfy Char.isUpper
cs <- Parse.munch validModuleChar
return (c:cs)
validModuleChar :: Char -> Bool
validModuleChar c = Char.isAlphaNum c || c == '_' || c == '\''
validModuleComponent :: String -> Bool
validModuleComponent [] = False
validModuleComponent (c:cs) = Char.isUpper c
&& all validModuleChar cs
{-# DEPRECATED simple "use ModuleName.fromString instead" #-}
simple :: String -> ModuleName
simple str = ModuleName [str]
fromString :: String -> ModuleName
fromString string
| all validModuleComponent components' = ModuleName components'
| otherwise = error badName
where
components' = split string
badName = "ModuleName.fromString: invalid module name " ++ show string
split cs = case break (=='.') cs of
(chunk,[]) -> chunk : []
(chunk,_:rest) -> chunk : split rest
main :: ModuleName
main = ModuleName ["Main"]
components :: ModuleName -> [String]
components (ModuleName ms) = ms
toFilePath :: ModuleName -> FilePath
toFilePath = intercalate [pathSeparator] . components