Skip to content

Commit

Permalink
Remove CabalParsing class, specialize to ParsecParser
Browse files Browse the repository at this point in the history
  • Loading branch information
FinleyMcIlwaine committed Jun 7, 2024
1 parent dda541c commit 9c43166
Show file tree
Hide file tree
Showing 26 changed files with 120 additions and 119 deletions.
4 changes: 2 additions & 2 deletions Cabal-syntax/src/Distribution/Backpack.hs
Original file line number Diff line number Diff line change
Expand Up @@ -228,7 +228,7 @@ dispOpenModuleSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v
-- | Inverse to 'dispModSubst'.
--
-- @since 2.2
parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst
parsecOpenModuleSubst :: ParsecParser OpenModuleSubst
parsecOpenModuleSubst =
fmap Map.fromList
. flip P.sepBy (P.char ',')
Expand All @@ -237,7 +237,7 @@ parsecOpenModuleSubst =
-- | Inverse to 'dispModSubstEntry'.
--
-- @since 2.2
parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule)
parsecOpenModuleSubstEntry :: ParsecParser (ModuleName, OpenModule)
parsecOpenModuleSubstEntry =
do
k <- parsec
Expand Down
13 changes: 6 additions & 7 deletions Cabal-syntax/src/Distribution/FieldGrammar/FieldDescrs.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ import qualified Text.PrettyPrint as Disp
-- strict pair
data SP s = SP
{ pPretty :: !(s -> Disp.Doc)
, pParse :: !(forall m. P.CabalParsing m => s -> m s)
, pParse :: !(s -> P.ParsecParser s)
}

-- | A collection of field parsers and pretty-printers.
Expand All @@ -40,21 +40,20 @@ instance Applicative (FieldDescrs s) where
pure _ = F mempty
f <*> x = F (mappend (runF f) (runF x))

singletonF :: P.FieldName -> (s -> Disp.Doc) -> (forall m. P.CabalParsing m => s -> m s) -> FieldDescrs s a
singletonF :: P.FieldName -> (s -> Disp.Doc) -> (s -> P.ParsecParser s) -> FieldDescrs s a
singletonF fn f g = F $ Map.singleton fn (SP f g)

-- | Lookup a field value pretty-printer.
fieldDescrPretty :: FieldDescrs s a -> P.FieldName -> Maybe (s -> Disp.Doc)
fieldDescrPretty (F m) fn = pPretty <$> Map.lookup fn m

-- | Lookup a field value parser.
fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> P.FieldName -> Maybe (s -> m s)
fieldDescrParse :: FieldDescrs s a -> P.FieldName -> Maybe (s -> P.ParsecParser s)
fieldDescrParse (F m) fn = (\f -> pParse f) <$> Map.lookup fn m

fieldDescrsToList
:: P.CabalParsing m
=> FieldDescrs s a
-> [(P.FieldName, s -> Disp.Doc, s -> m s)]
:: FieldDescrs s a
-> [(P.FieldName, s -> Disp.Doc, s -> P.ParsecParser s)]
fieldDescrsToList = map mk . Map.toList . runF
where
mk (name, SP ppr parse) = (name, ppr, parse)
Expand Down Expand Up @@ -111,7 +110,7 @@ instance FieldGrammar ParsecPretty FieldDescrs where
availableSince _ _ = id
hiddenField _ = F mempty

parsecFreeText :: P.CabalParsing m => m String
parsecFreeText :: P.ParsecParser String
parsecFreeText = dropDotLines <$ C.spaces <*> many C.anyChar
where
-- Example package with dot lines
Expand Down
6 changes: 3 additions & 3 deletions Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,8 +96,8 @@ data NoCommaFSep = NoCommaFSep
class Sep sep where
prettySep :: Proxy sep -> [Doc] -> Doc

parseSep :: CabalParsing m => Proxy sep -> m a -> m [a]
parseSepNE :: CabalParsing m => Proxy sep -> m a -> m (NonEmpty a)
parseSep :: Proxy sep -> ParsecParser a -> ParsecParser [a]
parseSepNE :: Proxy sep -> ParsecParser a -> ParsecParser (NonEmpty a)

instance Sep CommaVCat where
prettySep _ = vcat . punctuate comma
Expand Down Expand Up @@ -449,7 +449,7 @@ instance Pretty TestedWith where
pretty x = case unpack x of
(compiler, vr) -> pretty compiler <+> pretty vr

parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange)
parsecTestedWith :: ParsecParser (CompilerFlavor, VersionRange)
parsecTestedWith = do
name <- lexemeParsec
ver <- parsec <|> pure anyVersion
Expand Down
14 changes: 7 additions & 7 deletions Cabal-syntax/src/Distribution/ModuleName.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,27 +57,27 @@ instance Pretty ModuleName where
instance Parsec ModuleName where
parsec = parsecModuleName

parsecModuleName :: forall m. CabalParsing m => m ModuleName
parsecModuleName :: ParsecParser ModuleName
parsecModuleName = state0 DList.empty
where
upper :: m Char
upper :: ParsecParser Char
!upper = P.satisfy isUpper

ch :: m Char
ch :: ParsecParser Char
!ch = P.satisfy (\c -> validModuleChar c || c == '.')

alt :: m ModuleName -> m ModuleName -> m ModuleName
alt :: ParsecParser ModuleName -> ParsecParser ModuleName -> ParsecParser ModuleName
!alt = (<|>)

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

state1 :: DList.DList Char -> m ModuleName
state1 :: DList.DList Char -> ParsecParser ModuleName
state1 acc = state1' acc `alt` return (fromString (DList.toList acc))

state1' :: DList.DList Char -> m ModuleName
state1' :: DList.DList Char -> ParsecParser ModuleName
state1' acc = do
c <- ch
case c of
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,7 @@ simplifyWithSysParams os arch cinfo cond = (cond', flags)
--

-- | Parse a configuration condition from a string.
parseCondition :: CabalParsing m => m (Condition ConfVar)
parseCondition :: ParsecParser (Condition ConfVar)
parseCondition = condOr
where
condOr = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr
Expand Down
Loading

0 comments on commit 9c43166

Please sign in to comment.