refactor: do not bound error types

drlkf · drlkf · commit e34bc1996d6c · 2025-07-07T20:11:39.000+02:00
diff --git a/src/Text/Megaparsec/Time.hs b/src/Text/Megaparsec/Time.hs
@@ -21,18 +21,21 @@ import           Data.Time                 (Day, DayOfWeek (..),
                                             NominalDiffTime, TimeOfDay (..),
                                             defaultTimeLocale, parseTimeM,
                                             secondsToNominalDiffTime)
-import           Data.Void                 (Void)
 import           Text.Megaparsec           (Parsec, takeRest, try)
 import           Text.Megaparsec.Char      (char, digitChar, space, space1,
                                             string')
 import           Text.Megaparsec.Utils     (posNumParser)
 
 type DayResult = Either Int DayOfWeek
 
-dateParser :: Parsec Void String (Maybe DayResult, TimeOfDay)
+dateParser
+  :: Ord e
+  => Parsec e String (Maybe DayResult, TimeOfDay)
 dateParser = (,) <$> optional (try (dayParser <* space1)) <*> timeParser
 
-dayParser :: Parsec Void String DayResult
+dayParser
+  :: Ord e
+  => Parsec e String DayResult
 dayParser = choice
   [ Right <$> longDay
   , Right <$> shortDay
@@ -48,7 +51,9 @@ dayParser = choice
           absoluteDay = toEnum . read <$> some digitChar
           relativeDay = ($) <$> sign <*> (read <$> some digitChar)
 
-durationParser :: Parsec Void String NominalDiffTime
+durationParser
+  :: Ord e
+  => Parsec e String NominalDiffTime
 durationParser = try hours <|> try minutes <|> secondsParser
   where hours = do
           h <- hoursParser <* space
@@ -63,22 +68,32 @@ durationParser = try hours <|> try minutes <|> secondsParser
 
           return $ m + s
 
-gregorianDayParser :: Parsec Void String Day
+gregorianDayParser
+  :: Ord e
+  => Parsec e String Day
 gregorianDayParser = do
   s <- takeRest
   parseTimeM False defaultTimeLocale "%F" s <|>
     parseTimeM False defaultTimeLocale "%d/%m/%Y" s
 
-hoursParser :: Parsec Void String NominalDiffTime
+hoursParser
+  :: Ord e
+  => Parsec e String NominalDiffTime
 hoursParser = secondsToNominalDiffTime . (* 3600) <$> posNumParser <* char 'h'
 
-minutesParser :: Parsec Void String NominalDiffTime
+minutesParser
+  :: Ord e
+  => Parsec e String NominalDiffTime
 minutesParser = secondsToNominalDiffTime . (* 60) <$> posNumParser <* char 'm'
 
-secondsParser :: Parsec Void String NominalDiffTime
+secondsParser
+  :: Ord e
+  => Parsec e String NominalDiffTime
 secondsParser = secondsToNominalDiffTime <$> posNumParser <* optional (char 's')
 
-timeParser :: Parsec Void String TimeOfDay
+timeParser
+  :: Ord e
+  => Parsec e String TimeOfDay
 timeParser = do
   h <- read <$> replicateM 2 digitChar
   void $ char ':'
diff --git a/src/Text/Megaparsec/Utils.hs b/src/Text/Megaparsec/Utils.hs
@@ -26,66 +26,85 @@ import           Data.Maybe                      (fromJust)
 import qualified Data.Text                       as T (unpack)
 import           Data.UUID                       (UUID)
 import qualified Data.UUID                       as U (fromString)
-import           Data.Void                       (Void)
-import           Text.Megaparsec                 (Parsec, anySingle,
-                                                  errorBundlePretty, runParser,
-                                                  try)
+import           Text.Megaparsec                 (Parsec, ShowErrorComponent,
+                                                  anySingle, errorBundlePretty,
+                                                  runParser, try)
 import           Text.Megaparsec.Char            (char, digitChar, hexDigitChar,
                                                   string')
 
 -- | Parse a case-insensitive human-readable boolean, including C-style numbers
 -- and English yes-no.
-boolParser :: Parsec Void String Bool
+boolParser
+  :: Ord e
+  => Parsec e String Bool
 boolParser = true <|> false
   where true  = True  <$ choice (map string' ["true", "y", "yes", "1"])
         false = False <$ choice (map string' ["false", "n", "no", "0"])
 
 -- | Parse a 'Bounded' 'Enum' type that has a 'Show' instance, trying all
 -- possibilities, case-insensitive, in the 'Enum' order.
 boundedEnumShowParser
-  :: Bounded a
+  :: Ord e
+  => Bounded a
   => Enum a
   => Show a
-  => Parsec Void String a
+  => Parsec e String a
 boundedEnumShowParser =
   choice . map parseShow $ sortOn (negate . length . show) [minBound ..]
   where parseShow a = string' (show a) $> a
 
 -- | Parse a comma-separated list of items.
-commaSeparated :: Parsec Void String a -> Parsec Void String (NonEmpty a)
+commaSeparated
+  :: Ord e
+  => Parsec e String a
+  -> Parsec e String (NonEmpty a)
 commaSeparated p = (:|) <$> p <*> many (char ',' >> p)
 
 -- | Parse any occurrence of a given parser. Consumes any input before occurence.
-occurrence :: Parsec Void String a -> Parsec Void String a
+occurrence
+  :: Ord e
+  => Parsec e String a
+  -> Parsec e String a
 occurrence p = go
   where go = p <|> (anySingle >> go)
 
 -- | Parse all occurrences of a given parser.
-occurrences :: Parsec Void String a -> Parsec Void String [a]
+occurrences
+  :: Ord e
+  => Parsec e String a
+  -> Parsec e String [a]
 occurrences = some . try . occurrence . try
 
 -- | Parse a positive number with decimals.
-posDecNumParser :: Parsec Void String Double
+posDecNumParser
+  :: Ord e
+  => Parsec e String Double
 posDecNumParser = do
   num <- some digitChar
   den <- maybe "" ("." <>) <$> optional (char '.' >> some digitChar)
 
   return . read $ num <> den
 
 -- | Parse a positive integer.
-posNumParser :: Read a => Parsec Void String a
+posNumParser
+  :: Ord e
+  => Read a
+  => Parsec e String a
 posNumParser = read <$> some digitChar
 
 -- | Parse an integer, without any spaces between minus sign and digits.
-numParser :: Parsec Void String Int
+numParser
+  :: Ord e
+  => Parsec e String Int
 numParser = (char '-' >> negate <$> posNumParser) <|> posNumParser
 
 -- | Convert a 'Parsec' parser into a 'Parser' suited for 'FromJSON' instances.
 parsecToJSONParser
+  :: ShowErrorComponent e
   -- ^ Parser name.
-  :: String
+  => String
   -- ^ Parser.
-  -> Parsec Void String a
+  -> Parsec e String a
   -- ^ Input value.
   -> Value
   -> Parser a
@@ -94,11 +113,15 @@ parsecToJSONParser n p =
 
 -- | Convert a 'Parsec' parser into a 'ReadS' parser. Useful for defining 'Read'
 -- instances with 'Megaparsec'.
-parsecToReadsPrec :: Parsec Void String a -> ReadS a
+parsecToReadsPrec
+  :: Parsec e String a
+  -> ReadS a
 parsecToReadsPrec p = either (const []) (\x -> [(x, "")]) . runParser p "string"
 
 -- | Parse a RFC4122-compliant UUID.
-uuidParser :: Parsec Void String UUID
+uuidParser
+  :: Ord e
+  => Parsec e String UUID
 uuidParser = do
   part1 <- replicateM 8 hexDigitChar
   void $ char '-'
diff --git a/test/Text/Megaparsec/UtilsSpec.hs b/test/Text/Megaparsec/UtilsSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Text.Megaparsec.UtilsSpec
@@ -111,44 +112,46 @@ parseOrPrettyError p = first errorBundlePretty . runParser p "test"
 
 spec :: Spec
 spec = do
+  let parseMaybe' = parseMaybe @Void
+
   describe "parsers" $ do
     it "SomeData" . property $ \v ->
-      parseMaybe someDataParser (show (v :: SomeData)) `shouldBe` Just v
+      parseMaybe' someDataParser (show (v :: SomeData)) `shouldBe` Just v
 
     it "SomeEnum" . property $ \v ->
-      parseMaybe someEnumParser (show (v :: SomeEnum)) `shouldBe` Just v
+      parseMaybe' someEnumParser (show (v :: SomeEnum)) `shouldBe` Just v
 
     it "SomeADT" . property $ \v ->
-      parseMaybe someADTParser (show (v :: SomeADT)) `shouldBe` Just v
+      parseMaybe' someADTParser (show (v :: SomeADT)) `shouldBe` Just v
 
     context "posDecNumParser" $ do
       it "no decimals" . property $ \v ->
-        parseMaybe posDecNumParser (show (abs (v :: Int))) `shouldBe`
+        parseMaybe' posDecNumParser (show (abs (v :: Int))) `shouldBe`
         Just (fromIntegral (abs v))
 
       it "decimals" . property $ \v ->
-        parseMaybe posDecNumParser (printf "%f" (abs (v :: Double))) `shouldBe`
+        parseMaybe' posDecNumParser (printf "%f" (abs (v :: Double))) `shouldBe`
         Just (abs v)
 
     it "posNumParser" . property $ \v ->
-      parseMaybe posNumParser (show (abs (v :: Int))) `shouldBe` Just (abs v)
+      parseMaybe' posNumParser (show (abs (v :: Int))) `shouldBe` Just (abs v)
 
     it "numParser" . property $ \v ->
-      parseMaybe numParser (show (v :: Int)) `shouldBe` Just v
+      parseMaybe' numParser (show (v :: Int)) `shouldBe` Just v
 
   describe "boundedEnumShowParser" $ do
     context "lowercase" . exhaustive $ \v ->
-      parseMaybe (boundedEnumShowParser <* eof) (show v) `shouldBe` Just (v :: SomeEnum)
+      parseMaybe' (boundedEnumShowParser <* eof) (show v) `shouldBe` Just (v :: SomeEnum)
 
     context "uppercase" . exhaustive $ \v ->
-      parseMaybe (boundedEnumShowParser <* eof) (map toUpper (show v))
+      parseMaybe' (boundedEnumShowParser <* eof) (map toUpper (show v))
       `shouldBe` Just (v :: SomeEnum)
 
     context "mixed" . exhaustive $ \v -> do
       let capitalize i x | even i    = toUpper x
                          | otherwise = x
           mixCase = zipWith capitalize [(0 :: Int) ..]
-      parseMaybe (boundedEnumShowParser <* eof) (mixCase (show v))
+      parseMaybe' (boundedEnumShowParser <* eof) (mixCase (show v))
         `shouldBe` Just (v :: SomeEnum)
 
   describe "occurrence" $ do
