1- {-# LANGUAGE DeriveDataTypeable #-}
2- {-# LANGUAGE DeriveGeneric #-}
3-
1+ {-# LANGUAGE BangPatterns #-}
2+ {-# LANGUAGE DeriveDataTypeable #-}
3+ {-# LANGUAGE DeriveGeneric #-}
4+ {-# LANGUAGE ScopedTypeVariables #-}
45-----------------------------------------------------------------------------
56-- |
67-- Module : Distribution.ModuleName
1314-- Data type for Haskell module names.
1415
1516module Distribution.ModuleName (
16- ModuleName ( .. ), -- TODO: move Parsec instance here, don't export constructor
17+ ModuleName ,
1718 fromString ,
1819 fromComponents ,
1920 components ,
@@ -33,41 +34,65 @@ import Distribution.Utils.ShortText (ShortText, fromShortText, toShortTex
3334import System.FilePath (pathSeparator )
3435
3536import qualified Distribution.Compat.CharParsing as P
37+ import qualified Distribution.Compat.DList as DList
3638import qualified Text.PrettyPrint as Disp
3739
3840-- | A valid Haskell module name.
3941--
40- newtype ModuleName = ModuleName ShortTextLst
42+ newtype ModuleName = ModuleName ShortText
4143 deriving (Eq , Generic , Ord , Read , Show , Typeable , Data )
4244
45+ unModuleName :: ModuleName -> String
46+ unModuleName (ModuleName s) = fromShortText s
47+
4348instance Binary ModuleName
4449instance Structured ModuleName
4550
4651instance NFData ModuleName where
4752 rnf (ModuleName ms) = rnf ms
4853
4954instance Pretty ModuleName where
50- pretty (ModuleName ms) =
51- Disp. hcat (intersperse (Disp. char ' .' map Disp. text $ stlToStrings ms))
55+ pretty = Disp. text . unModuleName
5256
5357instance Parsec ModuleName where
54- parsec = fromComponents <$> toList <$> P. sepByNonEmpty component (P. char ' .'
55- where
56- component = do
57- c <- P. satisfy isUpper
58- cs <- P. munch validModuleChar
59- return (c: cs)
58+ parsec = parsecModuleName
59+
60+ parsecModuleName :: forall m . CabalParsing m => m ModuleName
61+ parsecModuleName = state0 DList. empty where
62+ upper :: m Char
63+ ! upper = P. satisfy isUpper
64+
65+ ch :: m Char
66+ ! ch = P. satisfy (\ c -> validModuleChar c || c == ' .'
67+
68+ alt :: m ModuleName -> m ModuleName -> m ModuleName
69+ ! alt = (<|>)
70+
71+ state0 :: DList. DListChar -> m ModuleName
72+ state0 acc = do
73+ c <- upper
74+ state1 (DList. snoc acc c)
75+
76+ state1 :: DList. DListChar -> m ModuleName
77+ state1 acc = state1' acc `alt` return (fromString (DList. toList acc))
78+
79+ state1' :: DList. DListChar -> m ModuleName
80+ state1' acc = do
81+ c <- ch
82+ case c of
83+ ' .' -> state0 (DList. snoc acc c)
84+ _ -> state1 (DList. snoc acc c)
6085
6186instance Described ModuleName where
62- describe _ = RETodo
87+ describe _ = REMunch1 (reChar ' .' where
88+ component = RECharSet csUpper <> reMunchCS (csAlphaNum <> fromString " _'"
6389
6490validModuleChar :: Char -> Bool
6591validModuleChar c = isAlphaNum c || c == ' _' || c == ' \' '
6692
6793validModuleComponent :: String -> Bool
6894validModuleComponent [] = False
69- validModuleComponent (c: cs) = isUpper c
70- && all validModuleChar cs
95+ validModuleComponent (c: cs) = isUpper c && all validModuleChar cs
7196
7297-- | Construct a 'ModuleName' from a valid module name 'String'.
7398--
@@ -76,77 +101,36 @@ validModuleComponent (c:cs) = isUpper c
76101-- are parsing user input then use 'Distribution.Text.simpleParse' instead.
77102--
78103instance IsString ModuleName where
79- fromString string = fromComponents (split string)
80- where
81- split cs = case break (== ' .' of
82- (chunk,[] ) -> chunk : []
83- (chunk,_: rest) -> chunk : split rest
104+ fromString = ModuleName . toShortText
84105
85106-- | Construct a 'ModuleName' from valid module components, i.e. parts
86107-- separated by dots.
87108fromComponents :: [String -> ModuleName
88- fromComponents components'
89- | null components' = error zeroComponents
90- | all validModuleComponent components' = ModuleName (stlFromStrings components')
91- | otherwise = error badName
92- where
93- zeroComponents = " ModuleName.fromComponents: zero components"
94- badName = " ModuleName.fromComponents: invalid components " ++ show components'
109+ fromComponents comps = fromString (intercalate " ."
110+ {-# DEPRECATED fromComponents "Exists for cabal-install only" #-}
95111
96112-- | The module name @Main@.
97113--
98114main :: ModuleName
99- main = ModuleName (stlFromStrings [ " Main" ] )
115+ main = ModuleName (fromString " Main"
100116
101117-- | The individual components of a hierarchical module name. For example
102118--
103119-- > components (fromString "A.B.C") = ["A", "B", "C"]
104120--
105121components :: ModuleName -> [String
106- components (ModuleName ms) = stlToStrings ms
122+ components mn = split (unModuleName mn)
123+ where
124+ split cs = case break (== ' .' of
125+ (chunk,[] ) -> chunk : []
126+ (chunk,_: rest) -> chunk : split rest
107127
108128-- | Convert a module name to a file path, but without any file extension.
109129-- For example:
110130--
111131-- > toFilePath (fromString "A.B.C") = "A/B/C"
112132--
113133toFilePath :: ModuleName -> FilePath
114- toFilePath = intercalate [pathSeparator] . components
115-
116- ----------------------------------------------------------------------------
117- -- internal helper
118-
119- -- | Strict/unpacked representation of @[ShortText]@
120- data ShortTextLst = STLNil
121- | STLCons ! ShortText ! ShortTextLst
122- deriving (Eq , Generic , Ord , Typeable , Data )
123-
124- instance NFData ShortTextLst where
125- rnf = flip seq ()
126-
127- instance Show ShortTextLst where
128- showsPrec p = showsPrec p . stlToList
129-
130-
131- instance Read ShortTextLst where
132- readsPrec p = map (first stlFromList) . readsPrec p
133-
134- instance Binary ShortTextLst where
135- put = put . stlToList
136- get = stlFromList <$> get
137-
138- instance Structured ShortTextLst
139-
140- stlToList :: ShortTextLst -> [ShortText ]
141- stlToList STLNil = []
142- stlToList (STLCons st next) = st : stlToList next
143-
144- stlToStrings :: ShortTextLst -> [String
145- stlToStrings = map fromShortText . stlToList
146-
147- stlFromList :: [ShortText ] -> ShortTextLst
148- stlFromList [] = STLNil
149- stlFromList (x: xs) = STLCons x (stlFromList xs)
150-
151- stlFromStrings :: [String -> ShortTextLst
152- stlFromStrings = stlFromList . map toShortText
134+ toFilePath = map f . unModuleName where
135+ f ' .' = pathSeparator
136+ f c = c
0 commit comments