{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module CabalFix.FlatParse
(
ParserWarning (..),
runParserMaybe,
runParserEither,
runParserWarn,
runParser_,
runParser__,
runParser,
Parser,
Result (..),
depP,
versionP,
versionInts,
untilP,
nota,
ws_,
ws,
)
where
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as C
import Data.Char hiding (isDigit)
import Data.These
import FlatParse.Basic hiding (cut, take)
import GHC.Exts
import GHC.Generics (Generic)
import Prelude hiding (replicate)
runParserMaybe :: Parser e a -> ByteString -> Maybe a
runParserMaybe :: forall e a. Parser e a -> ByteString -> Maybe a
runParserMaybe Parser e a
p ByteString
b = case Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
p ByteString
b of
OK a
r ByteString
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
Result e a
Fail -> Maybe a
forall a. Maybe a
Nothing
Err e
_ -> Maybe a
forall a. Maybe a
Nothing
runParserEither :: (IsString e) => Parser e a -> ByteString -> Either e a
runParserEither :: forall e a. IsString e => Parser e a -> ByteString -> Either e a
runParserEither Parser e a
p ByteString
bs = case Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
p ByteString
bs of
Err e
e -> e -> Either e a
forall a b. a -> Either a b
Left e
e
OK a
a ByteString
_ -> a -> Either e a
forall a b. b -> Either a b
Right a
a
Result e a
Fail -> e -> Either e a
forall a b. a -> Either a b
Left e
"uncaught parse error"
data ParserWarning = ParserLeftover ByteString | ParserError ByteString | ParserUncaught deriving (ParserWarning -> ParserWarning -> Bool
(ParserWarning -> ParserWarning -> Bool)
-> (ParserWarning -> ParserWarning -> Bool) -> Eq ParserWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserWarning -> ParserWarning -> Bool
== :: ParserWarning -> ParserWarning -> Bool
$c/= :: ParserWarning -> ParserWarning -> Bool
/= :: ParserWarning -> ParserWarning -> Bool
Eq, Int -> ParserWarning -> ShowS
[ParserWarning] -> ShowS
ParserWarning -> String
(Int -> ParserWarning -> ShowS)
-> (ParserWarning -> String)
-> ([ParserWarning] -> ShowS)
-> Show ParserWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserWarning -> ShowS
showsPrec :: Int -> ParserWarning -> ShowS
$cshow :: ParserWarning -> String
show :: ParserWarning -> String
$cshowList :: [ParserWarning] -> ShowS
showList :: [ParserWarning] -> ShowS
Show, Eq ParserWarning
Eq ParserWarning =>
(ParserWarning -> ParserWarning -> Ordering)
-> (ParserWarning -> ParserWarning -> Bool)
-> (ParserWarning -> ParserWarning -> Bool)
-> (ParserWarning -> ParserWarning -> Bool)
-> (ParserWarning -> ParserWarning -> Bool)
-> (ParserWarning -> ParserWarning -> ParserWarning)
-> (ParserWarning -> ParserWarning -> ParserWarning)
-> Ord ParserWarning
ParserWarning -> ParserWarning -> Bool
ParserWarning -> ParserWarning -> Ordering
ParserWarning -> ParserWarning -> ParserWarning
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParserWarning -> ParserWarning -> Ordering
compare :: ParserWarning -> ParserWarning -> Ordering
$c< :: ParserWarning -> ParserWarning -> Bool
< :: ParserWarning -> ParserWarning -> Bool
$c<= :: ParserWarning -> ParserWarning -> Bool
<= :: ParserWarning -> ParserWarning -> Bool
$c> :: ParserWarning -> ParserWarning -> Bool
> :: ParserWarning -> ParserWarning -> Bool
$c>= :: ParserWarning -> ParserWarning -> Bool
>= :: ParserWarning -> ParserWarning -> Bool
$cmax :: ParserWarning -> ParserWarning -> ParserWarning
max :: ParserWarning -> ParserWarning -> ParserWarning
$cmin :: ParserWarning -> ParserWarning -> ParserWarning
min :: ParserWarning -> ParserWarning -> ParserWarning
Ord, (forall x. ParserWarning -> Rep ParserWarning x)
-> (forall x. Rep ParserWarning x -> ParserWarning)
-> Generic ParserWarning
forall x. Rep ParserWarning x -> ParserWarning
forall x. ParserWarning -> Rep ParserWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParserWarning -> Rep ParserWarning x
from :: forall x. ParserWarning -> Rep ParserWarning x
$cto :: forall x. Rep ParserWarning x -> ParserWarning
to :: forall x. Rep ParserWarning x -> ParserWarning
Generic)
runParserWarn :: Parser ByteString a -> ByteString -> These ParserWarning a
runParserWarn :: forall a.
Parser ByteString a -> ByteString -> These ParserWarning a
runParserWarn Parser ByteString a
p ByteString
bs = case Parser ByteString a -> ByteString -> Result ByteString a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser ByteString a
p ByteString
bs of
Err ByteString
e -> ParserWarning -> These ParserWarning a
forall a b. a -> These a b
This (ByteString -> ParserWarning
ParserError ByteString
e)
OK a
a ByteString
"" -> a -> These ParserWarning a
forall a b. b -> These a b
That a
a
OK a
a ByteString
x -> ParserWarning -> a -> These ParserWarning a
forall a b. a -> b -> These a b
These (ByteString -> ParserWarning
ParserLeftover (ByteString -> ParserWarning) -> ByteString -> ParserWarning
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
C.take Int
200 ByteString
x) a
a
Result ByteString a
Fail -> ParserWarning -> These ParserWarning a
forall a b. a -> These a b
This ParserWarning
ParserUncaught
runParser_ :: Parser String a -> ByteString -> a
runParser_ :: forall a. Parser String a -> ByteString -> a
runParser_ Parser String a
p ByteString
bs = case Parser String a -> ByteString -> Result String a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser String a
p ByteString
bs of
Err String
e -> String -> a
forall a. HasCallStack => String -> a
error String
e
OK a
a ByteString
_ -> a
a
Result String a
Fail -> String -> a
forall a. HasCallStack => String -> a
error String
"uncaught parse error"
runParser__ :: Parser String a -> ByteString -> a
runParser__ :: forall a. Parser String a -> ByteString -> a
runParser__ Parser String a
p ByteString
bs = case Parser String a -> ByteString -> Result String a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser String a
p ByteString
bs of
Err String
e -> String -> a
forall a. HasCallStack => String -> a
error String
e
OK a
a ByteString
"" -> a
a
OK a
_ ByteString
x -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"leftovers: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
C.unpack (Int -> ByteString -> ByteString
C.take Int
20 ByteString
x)
Result String a
Fail -> String -> a
forall a. HasCallStack => String -> a
error String
"uncaught parse error"
ws_ :: Parser e ()
ws_ :: forall e. Parser e ()
ws_ =
$( switch
[|
case _ of
" " -> ws_
"\n" -> ws_
"\t" -> ws_
"\r" -> ws_
"\f" -> ws_
_ -> pure ()
|]
)
{-# INLINE ws_ #-}
isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
' ' = Bool
True
isWhitespace Char
'\x0a' = Bool
True
isWhitespace Char
'\x09' = Bool
True
isWhitespace Char
'\x0c' = Bool
True
isWhitespace Char
'\x0d' = Bool
True
isWhitespace Char
_ = Bool
False
{-# INLINE isWhitespace #-}
ws :: Parser e Char
ws :: forall e. Parser e Char
ws = (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy Char -> Bool
isWhitespace
nota :: Char -> Parser e ByteString
nota :: forall e. Char -> Parser e ByteString
nota Char
c = ParserT PureMode e ()
-> (() -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan (ParserT PureMode e Char -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e ()
skipMany ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c))) (\() Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE nota #-}
untilP :: Char -> Parser e ByteString
untilP :: forall e. Char -> Parser e ByteString
untilP Char
c = Char -> Parser e ByteString
forall e. Char -> Parser e ByteString
nota Char
c Parser e ByteString
-> ParserT PureMode e Char -> Parser e ByteString
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
prefixComma :: Parser e ()
prefixComma :: forall e. Parser e ()
prefixComma = $(char ',') ParserT PureMode e ()
-> ParserT PureMode e () -> ParserT PureMode e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT PureMode e ()
forall e. Parser e ()
ws_
postfixComma :: Parser e ()
postfixComma :: forall e. Parser e ()
postfixComma = Parser e ()
forall e. Parser e ()
ws_ Parser e () -> Parser e () -> Parser e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> $(char ',')
initialPackageChar :: Parser e Char
initialPackageChar :: forall e. Parser e Char
initialPackageChar =
(Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfyAscii
( Char -> ByteString -> Bool
`C.elem`
( String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
[Char
'a' .. Char
'z']
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'A' .. Char
'Z']
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']
)
)
packageChar :: Parser e Char
packageChar :: forall e. Parser e Char
packageChar =
(Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfyAscii
( Char -> ByteString -> Bool
`C.elem`
( String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
[Char
'a' .. Char
'z']
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'A' .. Char
'Z']
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'-']
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']
)
)
validName :: Parser e String
validName :: forall e. Parser e String
validName = (:) (Char -> ShowS)
-> ParserT PureMode e Char -> ParserT PureMode e ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode e Char
forall e. Parser e Char
initialPackageChar ParserT PureMode e ShowS
-> ParserT PureMode e String -> ParserT PureMode e String
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Char -> ParserT PureMode e String
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParserT PureMode e Char
forall e. Parser e Char
packageChar
depP :: Parser e (ByteString, ByteString)
depP :: forall e. Parser e (ByteString, ByteString)
depP =
(,)
(ByteString -> ByteString -> (ByteString, ByteString))
-> ParserT PureMode e ByteString
-> ParserT PureMode e (ByteString -> (ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ParserT PureMode e () -> ParserT PureMode e (Maybe ())
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e (Maybe a)
optional ParserT PureMode e ()
forall e. Parser e ()
prefixComma
ParserT PureMode e (Maybe ())
-> ParserT PureMode e () -> ParserT PureMode e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e ()
forall e. Parser e ()
ws_
ParserT PureMode e ()
-> ParserT PureMode e ByteString -> ParserT PureMode e ByteString
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e String -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e ByteString
byteStringOf ParserT PureMode e String
forall e. Parser e String
validName
ParserT PureMode e ByteString
-> ParserT PureMode e () -> ParserT PureMode e ByteString
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e ()
forall e. Parser e ()
ws_
)
ParserT PureMode e (ByteString -> (ByteString, ByteString))
-> ParserT PureMode e ByteString
-> ParserT PureMode e (ByteString, ByteString)
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> ParserT PureMode e ByteString
forall e. Char -> Parser e ByteString
nota Char
','
ParserT PureMode e (ByteString, ByteString)
-> ParserT PureMode e (Maybe ())
-> ParserT PureMode e (ByteString, ByteString)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e () -> ParserT PureMode e (Maybe ())
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e (Maybe a)
optional ParserT PureMode e ()
forall e. Parser e ()
postfixComma
versionP :: Parser e [Int]
versionP :: forall e. Parser e [Int]
versionP = (:) (Int -> [Int] -> [Int])
-> ParserT PureMode e Int -> ParserT PureMode e ([Int] -> [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode e Int
forall e. Parser e Int
int ParserT PureMode e ([Int] -> [Int])
-> ParserT PureMode e [Int] -> ParserT PureMode e [Int]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Int -> ParserT PureMode e [Int]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ($(char '.') ParserT PureMode e ()
-> ParserT PureMode e Int -> ParserT PureMode e Int
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT PureMode e Int
forall e. Parser e Int
int)
digit :: Parser e Int
digit :: forall e. Parser e Int
digit = (\Char
c -> Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0') (Char -> Int) -> ParserT PureMode e Char -> ParserT PureMode e Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfyAscii Char -> Bool
isDigit
int :: Parser e Int
int :: forall e. Parser e Int
int = do
(Int
place, Int
n) <- (Int -> (Int, Int) -> (Int, Int))
-> Parser e Int
-> ParserT PureMode e (Int, Int)
-> ParserT PureMode e (Int, Int)
forall a b (st :: ZeroBitType) e.
(a -> b -> b) -> ParserT st e a -> ParserT st e b -> ParserT st e b
chainr (\Int
n (!Int
place, !Int
acc) -> (Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10, Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)) Parser e Int
forall e. Parser e Int
digit ((Int, Int) -> ParserT PureMode e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
case Int
place of
Int
1 -> Parser e Int
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
Int
_ -> Int -> Parser e Int
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
versionInts :: ByteString -> [Int]
versionInts :: ByteString -> [Int]
versionInts ByteString
x = Parser String [Int] -> ByteString -> [Int]
forall a. Parser String a -> ByteString -> a
runParser__ Parser String [Int]
forall e. Parser e [Int]
versionP ByteString
x