Better parsing of source-repository & flag sections

Author: konsumlamm

src/MicroCabal/Normalize.hs

@@ -51,9 +51,9 @@ libName (Cabal (g@(Section _ _ gs):ss)) = Cabal $ g : map set ss
 reduce :: FlagInfo -> Cabal -> Cabal
 reduce info c = reduce' (addFlags c) c
   where addFlags (Cabal ss) = info{ flags = flags info ++ concatMap sect ss }
-        sect (Section "flag" n fs) = [(n', dflt n' fs)]  where n' = map toLower n
+        sect (Section "flag" n fs) = [(map toLower n, dflt fs)]
         sect _ = []
-        dflt n fs = head $ [ b | Field "default" (VBool b) <- fs ] ++ [error $ "no default for flag " ++ show n]
+        dflt fs = head $ [ b | Field "default" (VBool b) <- fs ] ++ [True]
 
 reduce' :: FlagInfo -> Cabal -> Cabal
 reduce' info = mapField red

src/MicroCabal/Parse.hs

@@ -352,13 +352,48 @@ pSection = pWhite *> (
   <|< Section <$> pKeyWordNC "library"           <*>  libName <*> pFields
   <|< Section <$> pKeyWordNC "foreign-library"   <*>    pName <*> pFields
   <|< Section <$> pKeyWordNC "executable"        <*>    pName <*> pFields
-  <|< Section <$> pKeyWordNC "source-repository" <*>    pName <*> pFields
-  <|< Section <$> pKeyWordNC "flag"              <*>    pName <*> pFields
+  <|< Section <$> pKeyWordNC "source-repository" <*>    pName <*> pSourceRepositoryFields
+  <|< Section <$> pKeyWordNC "flag"              <*>    pName <*> pFlagFields
   <|< Section <$> pKeyWordNC "test-suite"        <*>    pName <*> pFields
   <|< Section <$> pKeyWordNC "benchmark"         <*>    pName <*> pFields
   )
   where libName = pName <|< pure ""
 
+pSourceRepositoryFields :: P [Field]
+pSourceRepositoryFields = pSpaces *> pNewLine *> emany pSourceRepositoryField
+  where
+    pSourceRepositoryField = do
+      pWhite
+      pushColumn
+      fn <- lower <$> pFieldName
+      pColon
+      v <- case fn of
+        "type"     -> VItem <$> pItem
+        "location" -> VItem <$> pItem
+        "module"   -> VItem <$> pItem
+        "branch"   -> VItem <$> pItem
+        "tag"      -> VItem <$> pItem
+        "subdir"   -> VItem <$> pItem
+        _ -> error $ "Unknown source-repository field: " ++ fn
+      pFieldSep
+      pure $ Field fn v
+
+pFlagFields :: P [Field]
+pFlagFields = pSpaces *> pNewLine *> emany pFlagField
+  where
+    pFlagField = do
+      pWhite
+      pushColumn
+      fn <- lower <$> pFieldName
+      pColon
+      v <- case fn of
+        "description" -> pFreeText
+        "default"     -> VBool <$> pBoolNL
+        "manual"      -> VBool <$> pBoolNL
+        _ -> error $ "Unknown flag field: " ++ fn
+      pFieldSep
+      pure $ Field fn v
+
 getParser :: FieldName -> P Value
 getParser f =
   if "x-" `isPrefixOf` f then pFreeTextX else
@@ -448,12 +483,6 @@ parsers =
   , "main-is"                        # (VItem <$> pItem)
   , "test-module"                    # (VItem <$> pItem)
   , "type"                           # (VItem <$> pItem)
-  -- source-repository fields
-  , "location"                       # (VItem <$> pItem)
-  -- flag fields
-  , "manual"                         # (VBool <$> pBoolNL)
-  , "default"                        # (VBool <$> pBoolNL)
-  , "tag"                            # pFreeText
   ]
   where ( # ) = (,)
   -- XXX use local fixity