Commit 494bdf55 authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Add Described ModuleName instance

parent e2978f5b
......@@ -17,6 +17,7 @@ import Distribution.Types.LibraryName
import Distribution.Types.PackageName
import Distribution.Types.SourceRepo
import Distribution.Types.UnqualComponentName
import Distribution.ModuleName
import Distribution.Types.VersionRange.Internal
import Distribution.Verbosity
import Distribution.Version
......@@ -129,6 +130,16 @@ instance Arbitrary VersionIntervals where
instance Arbitrary Bound where
arbitrary = elements [ExclusiveBound, InclusiveBound]
-------------------------------------------------------------------------------
-- ModuleName
-------------------------------------------------------------------------------
instance Arbitrary ModuleName where
arbitrary = fromString . intercalate "." <$> shortListOf1 4 comp where
comp = (:) <$> elements upper <*> shortListOf1 10 (elements moduleChar)
upper = ['A'..'Z']
moduleChar = [ c | c <- ['\0' .. '\255'], isAlphaNum c || c `elem` "_'" ]
-------------------------------------------------------------------------------
-- Dependency
-------------------------------------------------------------------------------
......
......@@ -29,6 +29,7 @@ module Distribution.FieldGrammar.Described (
-- * Character Sets
csChar,
csAlphaNum,
csUpper,
csNotSpace,
csNotSpaceOrComma,
) where
......@@ -128,6 +129,9 @@ csChar = CS.singleton
csAlphaNum :: CS.CharSet
csAlphaNum = CS.alphanum
csUpper :: CS.CharSet
csUpper = CS.upper
csNotSpace :: CS.CharSet
csNotSpace = CS.difference CS.universe $ CS.singleton ' '
......
......@@ -59,7 +59,8 @@ instance Parsec ModuleName where
return (c:cs)
instance Described ModuleName where
describe _ = RETodo
describe _ = REMunch1 (reChar '.') component where
component = RECharSet csUpper <> reMunchCS (csAlphaNum <> fromString "_'")
validModuleChar :: Char -> Bool
validModuleChar c = isAlphaNum c || c == '_' || c == '\''
......
......@@ -28,6 +28,7 @@ module Distribution.Utils.CharSet (
-- * Special lists
alpha,
alphanum,
upper,
) where
import Distribution.Compat.Prelude hiding (empty, null, toList)
......@@ -228,3 +229,9 @@ alpha = foldl' (flip insert) empty [ c | c <- [ minBound .. maxBound ], isAlpha
alphanum :: CharSet
alphanum = foldl' (flip insert) empty [ c | c <- [ minBound .. maxBound ], isAlphaNum c ]
{-# NOINLINE alphanum #-}
-- | Note: this set varies depending on @base@ version.
--
upper :: CharSet
upper = foldl' (flip insert) empty [ c | c <- [ minBound .. maxBound ], isUpper c ]
{-# NOINLINE upper #-}
......@@ -22,6 +22,7 @@ import Distribution.Types.Flag (FlagName)
import Distribution.Types.PackageName (PackageName)
import Distribution.Types.Version (Version)
import Distribution.Types.VersionRange (VersionRange)
import Distribution.ModuleName (ModuleName)
import qualified RERE as RE
import qualified RERE.CharSet as RE
......@@ -36,6 +37,7 @@ tests = testGroup "Described"
, testDescribed (Proxy :: Proxy Version)
, testDescribed (Proxy :: Proxy VersionRange)
, testDescribed (Proxy :: Proxy FlagName)
, testDescribed (Proxy :: Proxy ModuleName)
]
-------------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment