{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use <$>" #-}
module DotParse.FlatParse
( Error (..),
prettyError,
keyword,
keyword',
symbol,
symbol',
ws,
token,
ident,
cut,
cut',
testParser,
runParser_,
int,
double,
signed,
quoted,
htmlLike,
sepP,
wrapSquareP,
wrapSquarePrint,
wrapCurlyP,
wrapCurlyPrint,
wrapQuotePrint,
pointP,
Spline (..),
splineP,
rectP,
boolP,
nonEmptyP,
)
where
import Data.Bool
import Data.ByteString hiding (empty, head, length, map, zip, zipWith)
import qualified Data.ByteString.Char8 as B
import Data.Char hiding (isDigit)
import Data.List.NonEmpty
import DotParse.FlatParse.TH hiding (merge)
import FlatParse.Basic hiding (cut, lines)
import GHC.Generics
import NumHask.Space
import Prelude hiding (replicate)
testParser :: Show a => Parser Error a -> ByteString -> IO ()
testParser :: Parser Error a -> ByteString -> IO ()
testParser Parser Error a
p ByteString
b =
case Parser Error a -> ByteString -> Result Error a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Error a
p ByteString
b of
Err Error
e -> ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Error -> ByteString
prettyError ByteString
b Error
e
OK a
a ByteString
_ -> a -> IO ()
forall a. Show a => a -> IO ()
print a
a
Result Error a
Fail -> ByteString -> IO ()
B.putStrLn ByteString
"uncaught parse error"
runParser_ :: Parser Error a -> ByteString -> a
runParser_ :: Parser Error a -> ByteString -> a
runParser_ Parser Error a
p ByteString
b = case Parser Error a -> ByteString -> Result Error a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser Error a
p ByteString
b of
OK a
r ByteString
"" -> a
r
OK a
_ ByteString
x -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpackUTF8 (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString
"leftovers: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x
Result Error a
Fail -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Fail"
Err Error
e -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpackUTF8 (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Error -> ByteString
prettyError ByteString
b Error
e
digit :: Parser Error Int
digit :: Parser Error 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) -> Parser Error Char -> Parser Error Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Error Char
forall e. (Char -> Bool) -> Parser e Char
satisfyASCII Char -> Bool
isDigit
int :: Parser Error Int
int :: Parser Error Int
int = Parser Error Int -> Parser Error Int
forall e a. Parser e a -> Parser e a
token do
(Int
place, Int
n) <- (Int -> (Int, Int) -> (Int, Int))
-> Parser Error Int
-> Parser Error (Int, Int)
-> Parser Error (Int, Int)
forall a b e.
(a -> b -> b) -> Parser e a -> Parser e b -> Parser 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 Error Int
digit ((Int, Int) -> Parser Error (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
case Int
place of
Int
1 -> Parser Error Int
forall e a. Parser e a
empty
Int
_ -> Int -> Parser Error Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
digits :: Parser Error (Int, Int)
digits :: Parser Error (Int, Int)
digits = (Int -> (Int, Int) -> (Int, Int))
-> Parser Error Int
-> Parser Error (Int, Int)
-> Parser Error (Int, Int)
forall a b e.
(a -> b -> b) -> Parser e a -> Parser e b -> Parser 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 Error Int
digit ((Int, Int) -> Parser Error (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
double :: Parser Error Double
double :: Parser Error Double
double = Parser Error Double -> Parser Error Double
forall e a. Parser e a -> Parser e a
token do
(Int
placel, Int
nl) <- Parser Error (Int, Int)
digits
Parser Error (Int, Int)
-> ((Int, Int) -> Parser Error Double)
-> Parser Error Double
-> Parser Error Double
forall e a b.
Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
optioned
($(char '.') Parser Error ()
-> Parser Error (Int, Int) -> Parser Error (Int, Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error (Int, Int)
digits)
( \(Int
placer, Int
nr) ->
case (Int
placel, Int
placer) of
(Int
1, Int
1) -> Parser Error Double
forall e a. Parser e a
empty
(Int, Int)
_ -> Double -> Parser Error Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser Error Double) -> Double -> Parser Error Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nl Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
placer
)
( case Int
placel of
Int
1 -> Parser Error Double
forall e a. Parser e a
empty
Int
_ -> Double -> Parser Error Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser Error Double) -> Double -> Parser Error Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nl
)
signed :: Num b => Parser e b -> Parser e b
signed :: Parser e b -> Parser e b
signed Parser e b
p = Parser e () -> (() -> Parser e b) -> Parser e b -> Parser e b
forall e a b.
Parser e a -> (a -> Parser e b) -> Parser e b -> Parser e b
optioned $(char '-') (Parser e b -> () -> Parser e b
forall a b. a -> b -> a
const (((-b
1) b -> b -> b
forall a. Num a => a -> a -> a
*) (b -> b) -> Parser e b -> Parser e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e b
p)) Parser e b
p
quoted :: Parser Error String
quoted :: Parser Error [Char]
quoted =
$(symbol "\"") Parser Error () -> Parser Error [Char] -> Parser Error [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error Char -> Parser Error [Char]
forall e a. Parser e a -> Parser e [a]
many Parser Error Char
unquoteQuote Parser Error [Char] -> Parser Error () -> Parser Error [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(symbol' "\"")
unquoteQuote :: Parser Error Char
unquoteQuote :: Parser Error Char
unquoteQuote = do
Char
next <- (Char -> Bool) -> Parser Error Char
forall e. (Char -> Bool) -> Parser e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"')
case Char
next of
Char
'/' -> Parser Error ()
-> Parser Error Char -> Parser Error Char -> Parser Error Char
forall e a b. Parser e a -> Parser e b -> Parser e b -> Parser e b
branch (Parser Error () -> Parser Error ()
forall e a. Parser e a -> Parser e a
lookahead $(char '"')) (Char
'"' Char -> Parser Error () -> Parser Error Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char '"')) (Char -> Parser Error Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'/')
Char
x -> Char -> Parser Error Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
x
sepP :: Parser e ()
sepP :: Parser e ()
sepP =
Parser e () -> Parser e ()
forall e a. Parser e a -> Parser e a
token
$( switch
[|
case _ of
";" -> pure ()
"," -> pure ()
|]
)
wrapSquareP :: Parser Error a -> Parser Error a
wrapSquareP :: Parser Error a -> Parser Error a
wrapSquareP Parser Error a
p =
$(symbol "[") Parser Error () -> Parser Error a -> Parser Error a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error a
p Parser Error a -> Parser Error () -> Parser Error a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(symbol' "]")
wrapSquarePrint :: ByteString -> ByteString
wrapSquarePrint :: ByteString -> ByteString
wrapSquarePrint ByteString
b = ByteString
"[" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"]"
wrapQuotePrint :: ByteString -> ByteString
wrapQuotePrint :: ByteString -> ByteString
wrapQuotePrint ByteString
b = ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
wrapCurlyP :: Parser Error a -> Parser Error a
wrapCurlyP :: Parser Error a -> Parser Error a
wrapCurlyP Parser Error a
p = $(symbol "{") Parser Error () -> Parser Error a -> Parser Error a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error a
p Parser Error a -> Parser Error () -> Parser Error a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(symbol' "}")
wrapCurlyPrint :: ByteString -> ByteString
wrapCurlyPrint :: ByteString -> ByteString
wrapCurlyPrint ByteString
b = ByteString
"{" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"}"
pointP :: Parser Error (Point Double)
pointP :: Parser Error (Point Double)
pointP = Parser Error (Point Double) -> Parser Error (Point Double)
forall e a. Parser e a -> Parser e a
token (Parser Error (Point Double) -> Parser Error (Point Double))
-> Parser Error (Point Double) -> Parser Error (Point Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double -> Double -> Point Double)
-> Parser Error Double -> Parser Error (Double -> Point Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Error Double
double Parser Error (Double -> Point Double)
-> Parser Error Double -> Parser Error (Point Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ($(symbol ",") Parser Error () -> Parser Error Double -> Parser Error Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error Double
double)
data Spline = Spline {Spline -> Maybe (Point Double)
splineEnd :: Maybe (Point Double), Spline -> Maybe (Point Double)
splineStart :: Maybe (Point Double), Spline -> Point Double
splineP1 :: Point Double, Spline -> [(Point Double, Point Double, Point Double)]
splineTriples :: [(Point Double, Point Double, Point Double)]} deriving (Spline -> Spline -> Bool
(Spline -> Spline -> Bool)
-> (Spline -> Spline -> Bool) -> Eq Spline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spline -> Spline -> Bool
$c/= :: Spline -> Spline -> Bool
== :: Spline -> Spline -> Bool
$c== :: Spline -> Spline -> Bool
Eq, Int -> Spline -> ShowS
[Spline] -> ShowS
Spline -> [Char]
(Int -> Spline -> ShowS)
-> (Spline -> [Char]) -> ([Spline] -> ShowS) -> Show Spline
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Spline] -> ShowS
$cshowList :: [Spline] -> ShowS
show :: Spline -> [Char]
$cshow :: Spline -> [Char]
showsPrec :: Int -> Spline -> ShowS
$cshowsPrec :: Int -> Spline -> ShowS
Show, (forall x. Spline -> Rep Spline x)
-> (forall x. Rep Spline x -> Spline) -> Generic Spline
forall x. Rep Spline x -> Spline
forall x. Spline -> Rep Spline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Spline x -> Spline
$cfrom :: forall x. Spline -> Rep Spline x
Generic)
splineP :: Parser Error Spline
splineP :: Parser Error Spline
splineP =
Maybe (Point Double)
-> Maybe (Point Double)
-> Point Double
-> [(Point Double, Point Double, Point Double)]
-> Spline
Spline
(Maybe (Point Double)
-> Maybe (Point Double)
-> Point Double
-> [(Point Double, Point Double, Point Double)]
-> Spline)
-> Parser Error (Maybe (Point Double))
-> Parser
Error
(Maybe (Point Double)
-> Point Double
-> [(Point Double, Point Double, Point Double)]
-> Spline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Error (Point Double) -> Parser Error (Maybe (Point Double))
forall e a. Parser e a -> Parser e (Maybe a)
optional ($(symbol "e,") Parser Error ()
-> Parser Error (Point Double) -> Parser Error (Point Double)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error (Point Double)
pointP)
Parser
Error
(Maybe (Point Double)
-> Point Double
-> [(Point Double, Point Double, Point Double)]
-> Spline)
-> Parser Error (Maybe (Point Double))
-> Parser
Error
(Point Double
-> [(Point Double, Point Double, Point Double)] -> Spline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Point Double) -> Parser Error (Maybe (Point Double))
forall e a. Parser e a -> Parser e (Maybe a)
optional ($(symbol "s") Parser Error ()
-> Parser Error (Point Double) -> Parser Error (Point Double)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Error (Point Double)
pointP)
Parser
Error
(Point Double
-> [(Point Double, Point Double, Point Double)] -> Spline)
-> Parser Error (Point Double)
-> Parser
Error ([(Point Double, Point Double, Point Double)] -> Spline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Point Double)
pointP
Parser
Error ([(Point Double, Point Double, Point Double)] -> Spline)
-> Parser Error [(Point Double, Point Double, Point Double)]
-> Parser Error Spline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Point Double, Point Double, Point Double)
-> Parser Error [(Point Double, Point Double, Point Double)]
forall e a. Parser e a -> Parser e [a]
some ((,,) (Point Double
-> Point Double
-> Point Double
-> (Point Double, Point Double, Point Double))
-> Parser Error (Point Double)
-> Parser
Error
(Point Double
-> Point Double -> (Point Double, Point Double, Point Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Error (Point Double)
pointP Parser
Error
(Point Double
-> Point Double -> (Point Double, Point Double, Point Double))
-> Parser Error (Point Double)
-> Parser
Error (Point Double -> (Point Double, Point Double, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Point Double)
pointP Parser
Error (Point Double -> (Point Double, Point Double, Point Double))
-> Parser Error (Point Double)
-> Parser Error (Point Double, Point Double, Point Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Point Double)
pointP)
rectP :: Parser Error (Rect Double)
rectP :: Parser Error (Rect Double)
rectP = Parser Error (Rect Double) -> Parser Error (Rect Double)
forall e a. Parser e a -> Parser e a
token (Parser Error (Rect Double) -> Parser Error (Rect Double))
-> Parser Error (Rect Double) -> Parser Error (Rect Double)
forall a b. (a -> b) -> a -> b
$ do
Double
x <- Parser Error Double
double
()
_ <- $(symbol ",")
Double
y <- Parser Error Double
double
()
_ <- $(symbol ",")
Double
z <- Parser Error Double
double
()
_ <- $(symbol ",")
Double
w <- Parser Error Double
double
Rect Double -> Parser Error (Rect Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rect Double -> Parser Error (Rect Double))
-> Rect Double -> Parser Error (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
y Double
w
boolP :: Parser Error Bool
boolP :: Parser Error Bool
boolP =
(Bool
True Bool -> Parser Error () -> Parser Error Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(symbol "true"))
Parser Error Bool -> Parser Error Bool -> Parser Error Bool
forall e a. Parser e a -> Parser e a -> Parser e a
<|> (Bool
False Bool -> Parser Error () -> Parser Error Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(symbol "false"))
nonEmptyP :: Parser e a -> Parser e () -> Parser e (NonEmpty a)
nonEmptyP :: Parser e a -> Parser e () -> Parser e (NonEmpty a)
nonEmptyP Parser e a
p Parser e ()
sep = Parser e (NonEmpty a) -> Parser e (NonEmpty a)
forall e a. Parser e a -> Parser e a
token (Parser e (NonEmpty a) -> Parser e (NonEmpty a))
-> Parser e (NonEmpty a) -> Parser e (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ do
a
s <- Parser e a
p
[a]
xs <- Parser e a -> Parser e [a]
forall e a. Parser e a -> Parser e [a]
many (Parser e () -> Parser e (Maybe ())
forall e a. Parser e a -> Parser e (Maybe a)
optional Parser e ()
sep Parser e (Maybe ()) -> Parser e a -> Parser e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e a
p)
NonEmpty a -> Parser e (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
s a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)