{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
module Data.GraphViz.Parsing
(
module Text.ParserCombinators.Poly.StateText
, Parse
, ParseDot(..)
, parseIt
, parseIt'
, runParser
, runParser'
, runParserWith
, parseLiberally
, checkValidParse
, checkValidParseWithRest
, ignoreSep
, onlyBool
, quotelessString
, stringBlock
, numString
, isNumString
, isIntString
, quotedString
, parseEscaped
, parseAndSpace
, string
, strings
, character
, parseStrictFloat
, parseSignedFloat
, noneOf
, whitespace1
, whitespace
, wrapWhitespace
, optionalQuotedString
, optionalQuoted
, quotedParse
, orQuote
, quoteChar
, newline
, newline'
, parseComma
, parseEq
, tryParseList
, tryParseList'
, consumeLine
, commaSep
, commaSepUnqt
, commaSep'
, stringRep
, stringReps
, stringParse
, stringValue
, parseAngled
, parseBraced
, parseColorScheme
) where
import Data.GraphViz.Exception (GraphvizException(NotDotCode), throw)
import Data.GraphViz.Internal.State
import Data.GraphViz.Internal.Util
import Data.GraphViz.Attributes.ColorScheme
import Text.ParserCombinators.Poly.StateText hiding (empty, indent,
runParser)
import qualified Text.ParserCombinators.Poly.StateText as P
import Control.Arrow (first, second)
import Control.Monad (when)
import Data.Char (isDigit, isLower, isSpace, toLower,
toUpper)
import Data.Function (on)
import Data.List (groupBy, sortBy)
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe,
maybeToList)
import Data.Ratio ((%))
import qualified Data.Set as Set
import qualified Data.Text as ST
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Read as T
import Data.Version (Version(..))
import Data.Word (Word16, Word8)
type Parse a = Parser GraphvizState a
runParser :: Parse a -> Text -> (Either String a, Text)
runParser :: forall a. Parse a -> Text -> (Either [Char] a, Text)
runParser = forall a.
(GraphvizState -> GraphvizState)
-> Parse a -> Text -> (Either [Char] a, Text)
runParserWith forall a. a -> a
id
parseLiberally :: GraphvizState -> GraphvizState
parseLiberally :: GraphvizState -> GraphvizState
parseLiberally GraphvizState
gs = GraphvizState
gs { parseStrictly :: Bool
parseStrictly = Bool
False }
runParserWith :: (GraphvizState -> GraphvizState) -> Parse a -> Text
-> (Either String a, Text)
runParserWith :: forall a.
(GraphvizState -> GraphvizState)
-> Parse a -> Text -> (Either [Char] a, Text)
runParserWith GraphvizState -> GraphvizState
f Parse a
p Text
t = let (Either [Char] a
r,GraphvizState
_,Text
t') = forall s a. Parser s a -> s -> Text -> (Either [Char] a, s, Text)
P.runParser Parse a
p (GraphvizState -> GraphvizState
f GraphvizState
initialState) Text
t
in (Either [Char] a
r,Text
t')
runParser' :: Parse a -> Text -> a
runParser' :: forall a. Parse a -> Text -> a
runParser' Parse a
p = forall a. (Either [Char] a, Text) -> a
checkValidParseWithRest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parse a -> Text -> (Either [Char] a, Text)
runParser Parse a
p'
where
p' :: Parse a
p' = Parse a
p forall (p :: * -> *) a b. PolyParse p => p a -> p b -> p a
`discard` (Parser GraphvizState ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. Parser s ()
eof)
class ParseDot a where
parseUnqt :: Parse a
parse :: Parse a
parse = forall a. Parse a -> Parse a
optionalQuoted forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [a]
parseUnqtList = forall (p :: * -> *) bra sep ket a.
PolyParse p =>
p bra -> p sep -> p ket -> p a -> p [a]
bracketSep (forall a. Parse a -> Parse a
parseAndSpace forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
'[')
( forall a. Parse a -> Parse a
wrapWhitespace Parser GraphvizState ()
parseComma
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parser GraphvizState ()
whitespace1
)
(Parser GraphvizState ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parse Char
character Char
']')
forall a. ParseDot a => Parse a
parseUnqt
parseList :: Parse [a]
parseList = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse [a]
parseUnqtList
parseIt :: (ParseDot a) => Text -> (a, Text)
parseIt :: forall a. ParseDot a => Text -> (a, Text)
parseIt = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. Either [Char] a -> a
checkValidParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parse a -> Text -> (Either [Char] a, Text)
runParser forall a. ParseDot a => Parse a
parse
checkValidParse :: Either String a -> a
checkValidParse :: forall a. Either [Char] a -> a
checkValidParse (Left [Char]
err) = forall a e. Exception e => e -> a
throw ([Char] -> GraphvizException
NotDotCode [Char]
err)
checkValidParse (Right a
a) = a
a
checkValidParseWithRest :: (Either String a, Text) -> a
checkValidParseWithRest :: forall a. (Either [Char] a, Text) -> a
checkValidParseWithRest (Left [Char]
err, Text
rst) = forall a e. Exception e => e -> a
throw ([Char] -> GraphvizException
NotDotCode [Char]
err')
where
err' :: [Char]
err' = [Char]
err forall a. [a] -> [a] -> [a]
++ [Char]
"\n\nRemaining input:\n\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
rst
checkValidParseWithRest (Right a
a,Text
_) = a
a
parseIt' :: (ParseDot a) => Text -> a
parseIt' :: forall a. ParseDot a => Text -> a
parseIt' = forall a. Parse a -> Text -> a
runParser' forall a. ParseDot a => Parse a
parse
instance ParseDot Int where
parseUnqt :: Parse Int
parseUnqt = Parse Int
parseSignedInt
instance ParseDot Integer where
parseUnqt :: Parse Integer
parseUnqt = forall a. Num a => Parse a -> Parse a
parseSigned forall a. Integral a => Parse a
parseInt
instance ParseDot Word8 where
parseUnqt :: Parse Word8
parseUnqt = forall a. Integral a => Parse a
parseInt
instance ParseDot Word16 where
parseUnqt :: Parse Word16
parseUnqt = forall a. Integral a => Parse a
parseInt
instance ParseDot Double where
parseUnqt :: Parse Double
parseUnqt = Bool -> Parse Double
parseSignedFloat Bool
True
parse :: Parse Double
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parse Double
parseSignedFloat Bool
False
parseUnqtList :: Parse [Double]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt (Char -> Parse Char
character Char
':')
parseList :: Parse [Double]
parseList = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse [a]
parseUnqtList
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a. ParseDot a => Parse a
parse
instance ParseDot Bool where
parseUnqt :: Parse Bool
parseUnqt = Parse Bool
onlyBool
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
zero forall a. Eq a => a -> a -> Bool
/=) Parse Int
parseSignedInt
where
zero :: Int
zero :: Int
zero = Int
0
onlyBool :: Parse Bool
onlyBool :: Parse Bool
onlyBool = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> [Char] -> Parse a
stringRep Bool
True [Char]
"true"
, forall a. a -> [Char] -> Parse a
stringRep Bool
False [Char]
"false"
]
instance ParseDot Char where
parseUnqt :: Parse Char
parseUnqt = forall s. (Char -> Bool) -> Parser s Char
satisfy (Char
quoteChar forall a. Eq a => a -> a -> Bool
/=)
parse :: Parse Char
parse = forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
restIDString
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Char]
parseUnqtList = Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
parseList :: Parse [Char]
parseList = Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
instance ParseDot Version where
parseUnqt :: Parse Version
parseUnqt = [Int] -> Version
createVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 (forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
False) (Char -> Parse Char
character Char
'.')
parse :: Parse Version
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
([Int] -> Version
createVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
False) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parse Char
character Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parse a
parseInt)
instance ParseDot Text where
parseUnqt :: Parse Text
parseUnqt = Parse Text
quotedString
parse :: Parse Text
parse = Parse Text
quotelessString
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall a. Parse a -> Parse a
quotedParse Parse Text
quotedString
instance ParseDot ST.Text where
parseUnqt :: Parse Text
parseUnqt = Text -> Text
T.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
parse :: Parse Text
parse = Text -> Text
T.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse
instance (ParseDot a) => ParseDot [a] where
parseUnqt :: Parse [a]
parseUnqt = forall a. ParseDot a => Parse [a]
parseUnqtList
parse :: Parse [a]
parse = forall a. ParseDot a => Parse [a]
parseList
quotelessString :: Parse Text
quotelessString :: Parse Text
quotelessString = Bool -> Parse Text
numString Bool
False forall s a. Parser s a -> Parser s a -> Parser s a
`onFail` Parse Text
stringBlock
numString :: Bool -> Parse Text
numString :: Bool -> Parse Text
numString Bool
q = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> Text
tShow (Bool -> Parse Double
parseStrictFloat Bool
q)
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> Text
tShow Parse Int
parseSignedInt
where
tShow :: (Show a) => a -> Text
tShow :: forall a. Show a => a -> Text
tShow = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
stringBlock :: Parse Text
stringBlock :: Parse Text
stringBlock = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> Text -> Text
T.cons (forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
frstIDString) (forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
restIDString)
quotedString :: Parse Text
quotedString :: Parse Text
quotedString = Bool -> [Char] -> [Char] -> Parse Text
parseEscaped Bool
True [] []
parseSigned :: (Num a) => Parse a -> Parse a
parseSigned :: forall a. Num a => Parse a -> Parse a
parseSigned Parse a
p = (Char -> Parse Char
character Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate Parse a
p)
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parse a
p
parseInt :: (Integral a) => Parse a
parseInt :: forall a. Integral a => Parse a
parseInt = forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
True
parseIntCheck :: (Integral a) => Bool -> Parse a
parseIntCheck :: forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
ch = do Text
cs <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isDigit
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Expected one or more digits\n\t"forall a. [a] -> [a] -> [a]
++)
case forall a. Integral a => Reader a
T.decimal Text
cs of
Right (a
n,Text
"") -> forall a. a -> a -> Bool -> a
bool forall (m :: * -> *) a. Monad m => a -> m a
return forall {b}. b -> Parser GraphvizState b
checkInt Bool
ch a
n
Right (a
_,Text
txt) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Trailing digits not parsed as Integral: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
txt
Left [Char]
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read Integral: " forall a. [a] -> [a] -> [a]
++ [Char]
err
where
checkInt :: b -> Parser GraphvizState b
checkInt b
n = do Maybe Char
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Char -> Parse Char
character Char
'.', Char -> Parse Char
character Char
'e' ]
if forall a. Maybe a -> Bool
isJust Maybe Char
c
then forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"This number is actually Floating, not Integral!"
else forall (m :: * -> *) a. Monad m => a -> m a
return b
n
parseSignedInt :: Parse Int
parseSignedInt :: Parse Int
parseSignedInt = forall a. Num a => Parse a -> Parse a
parseSigned forall a. Integral a => Parse a
parseInt
parseStrictFloat :: Bool -> Parse Double
parseStrictFloat :: Bool -> Parse Double
parseStrictFloat = forall a. Num a => Parse a -> Parse a
parseSigned forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFrac a => Bool -> Parse a
parseFloat
parseFloat :: (RealFrac a) => Bool -> Parse a
parseFloat :: forall a. RealFrac a => Bool -> Parse a
parseFloat Bool
q = do Text
ds <- forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
isDigit
Maybe Text
frac <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
isDigit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
ds Bool -> Bool -> Bool
&& Maybe Text -> Bool
noDec Maybe Text
frac)
(forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No actual digits in floating point number!")
Maybe Int
expn <- forall a. a -> a -> Bool -> a
bool (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parse Int
parseExp) Bool
q
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe Text
frac Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Int
expn)
(forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"This is an integer, not a floating point number!")
let frac' :: Text
frac' = forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
frac
expn' :: Int
expn' = forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
expn
( forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* (Rational
10forall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int
expn' forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
T.length Text
frac'))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> Ratio a
%Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parse a -> Text -> a
runParser' forall a. Integral a => Parse a
parseInt) (Text
ds Text -> Text -> Text
`T.append` Text
frac')
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected a floating point number"
where
parseExp :: Parse Int
parseExp = Char -> Parse Char
character Char
'e'
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Char -> Parse Char
character Char
'+' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parse a
parseInt)
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parse Int
parseSignedInt)
noDec :: Maybe Text -> Bool
noDec = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Text -> Bool
T.null
parseSignedFloat :: Bool -> Parse Double
parseSignedFloat :: Bool -> Parse Double
parseSignedFloat Bool
q = forall a. Num a => Parse a -> Parse a
parseSigned ( forall a. RealFrac a => Bool -> Parse a
parseFloat Bool
q forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Double
fI forall a. Integral a => Parse a
parseInt )
where
fI :: Integer -> Double
fI :: Integer -> Double
fI = forall a b. (Integral a, Num b) => a -> b
fromIntegral
parseAndSpace :: Parse a -> Parse a
parseAndSpace :: forall a. Parse a -> Parse a
parseAndSpace Parse a
p = Parse a
p forall (p :: * -> *) a b. PolyParse p => p a -> p b -> p a
`discard` Parser GraphvizState ()
whitespace
string :: String -> Parse ()
string :: [Char] -> Parser GraphvizState ()
string = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Parse Char
character
stringRep :: a -> String -> Parse a
stringRep :: forall a. a -> [Char] -> Parse a
stringRep a
v = forall a. a -> [[Char]] -> Parse a
stringReps a
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
stringReps :: a -> [String] -> Parse a
stringReps :: forall a. a -> [[Char]] -> Parse a
stringReps a
v [[Char]]
ss = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Parser GraphvizState ()
string [[Char]]
ss) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
stringParse :: [(String, Parse a)] -> Parse a
stringParse :: forall a. [([Char], Parse a)] -> Parse a
stringParse = forall a. [([Char], Parse a)] -> Parse a
toPM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
where
toPM :: [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
toPM = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
mkPM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))
mkPM :: [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
mkPM [([Char]
"",Parser GraphvizState a
p)] = Parser GraphvizState a
p
mkPM [([Char]
str,Parser GraphvizState a
p)] = [Char] -> Parser GraphvizState ()
string [Char]
str forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState a
p
mkPM [([Char], Parser GraphvizState a)]
kv = Char -> Parse Char
character (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [([Char], Parser GraphvizState a)]
kv) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
toPM (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. [a] -> [a]
tail) [([Char], Parser GraphvizState a)]
kv)
stringValue :: [(String, a)] -> Parse a
stringValue :: forall a. [([Char], a)] -> Parse a
stringValue = forall a. [([Char], Parse a)] -> Parse a
stringParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (m :: * -> *) a. Monad m => a -> m a
return)
strings :: [String] -> Parse ()
strings :: [[Char]] -> Parser GraphvizState ()
strings = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Parser GraphvizState ()
string
character :: Char -> Parse Char
character :: Char -> Parse Char
character Char
c = forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
parseC
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr`
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [Char]
"Not the expected character: " forall a. [a] -> [a] -> [a]
++ [Char
c])
where
parseC :: Char -> Bool
parseC Char
c' = Char
c' forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char -> Char
flipCase Char
c'
flipCase :: Char -> Char
flipCase Char
c' = if Char -> Bool
isLower Char
c'
then Char -> Char
toUpper Char
c'
else Char -> Char
toLower Char
c'
noneOf :: [Char] -> Parse Char
noneOf :: [Char] -> Parse Char
noneOf [Char]
t = forall s. (Char -> Bool) -> Parser s Char
satisfy (\Char
x -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
/= Char
x) [Char]
t)
whitespace1 :: Parse ()
whitespace1 :: Parser GraphvizState ()
whitespace1 = forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
whitespace :: Parse ()
whitespace :: Parser GraphvizState ()
whitespace = forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
wrapWhitespace :: Parse a -> Parse a
wrapWhitespace :: forall a. Parse a -> Parse a
wrapWhitespace = forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket Parser GraphvizState ()
whitespace Parser GraphvizState ()
whitespace
optionalQuotedString :: String -> Parse ()
optionalQuotedString :: [Char] -> Parser GraphvizState ()
optionalQuotedString = forall a. Parse a -> Parse a
optionalQuoted forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Parser GraphvizState ()
string
optionalQuoted :: Parse a -> Parse a
optionalQuoted :: forall a. Parse a -> Parse a
optionalQuoted Parse a
p = forall a. Parse a -> Parse a
quotedParse Parse a
p
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parse a
p
quotedParse :: Parse a -> Parse a
quotedParse :: forall a. Parse a -> Parse a
quotedParse = forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket Parser GraphvizState ()
parseQuote Parser GraphvizState ()
parseQuote
parseQuote :: Parse ()
parseQuote :: Parser GraphvizState ()
parseQuote = Char -> Parse Char
character Char
quoteChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
orQuote :: Parse Char -> Parse Char
orQuote :: Parse Char -> Parse Char
orQuote Parse Char
p = forall a. a -> [Char] -> Parse a
stringRep Char
quoteChar [Char]
"\\\""
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parse Char
p
quoteChar :: Char
quoteChar :: Char
quoteChar = Char
'"'
parseEscaped :: Bool -> [Char] -> [Char] -> Parse Text
parseEscaped :: Bool -> [Char] -> [Char] -> Parse Text
parseEscaped Bool
empt [Char]
cs [Char]
bnd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Parser GraphvizState a -> Parser GraphvizState [a]
lots forall a b. (a -> b) -> a -> b
$ Parse Char
qPrs forall s a. Parser s a -> Parser s a -> Parser s a
`onFail` forall {s}. Parser s Char
oth
where
lots :: Parser GraphvizState a -> Parser GraphvizState [a]
lots = if Bool
empt then forall (f :: * -> *) a. Alternative f => f a -> f [a]
many else forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1
cs' :: [Char]
cs' = Char
quoteChar forall a. a -> [a] -> [a]
: Char
slash forall a. a -> [a] -> [a]
: [Char]
cs
csSet :: Set Char
csSet = forall a. Ord a => [a] -> Set a
Set.fromList [Char]
cs'
bndSet :: Set Char
bndSet = forall a. Ord a => [a] -> Set a
Set.fromList [Char]
bnd forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Char
csSet
slash :: Char
slash = Char
'\\'
qPrs :: Parse Char
qPrs = forall a. a -> Maybe a -> a
fromMaybe Char
slash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parse Char
character Char
slash
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Parse Char
character [Char]
cs')
)
oth :: Parser s Char
oth = forall s. (Char -> Bool) -> Parser s Char
satisfy (forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Char
bndSet)
newline :: Parse ()
newline :: Parser GraphvizState ()
newline = [[Char]] -> Parser GraphvizState ()
strings [[Char]
"\r\n", [Char]
"\n", [Char]
"\r"]
newline' :: Parse ()
newline' :: Parser GraphvizState ()
newline' = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser GraphvizState ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
newline) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
consumeLine :: Parse Text
consumeLine :: Parse Text
consumeLine = forall s. (Char -> Bool) -> Parser s Text
manySatisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n',Char
'\r'])
parseEq :: Parse ()
parseEq :: Parser GraphvizState ()
parseEq = forall a. Parse a -> Parse a
wrapWhitespace (Char -> Parse Char
character Char
'=') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ignoreSep :: (a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c
ignoreSep :: forall a b c sep.
(a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c
ignoreSep a -> b -> c
f Parse a
pa Parse sep
sep Parse b
pb = a -> b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parse sep
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse b
pb
commaSep :: (ParseDot a, ParseDot b) => Parse (a, b)
commaSep :: forall a b. (ParseDot a, ParseDot b) => Parse (a, b)
commaSep = forall a b. Parse a -> Parse b -> Parse (a, b)
commaSep' forall a. ParseDot a => Parse a
parse forall a. ParseDot a => Parse a
parse
commaSepUnqt :: (ParseDot a, ParseDot b) => Parse (a, b)
commaSepUnqt :: forall a b. (ParseDot a, ParseDot b) => Parse (a, b)
commaSepUnqt = forall a b. Parse a -> Parse b -> Parse (a, b)
commaSep' forall a. ParseDot a => Parse a
parseUnqt forall a. ParseDot a => Parse a
parseUnqt
commaSep' :: Parse a -> Parse b -> Parse (a,b)
commaSep' :: forall a b. Parse a -> Parse b -> Parse (a, b)
commaSep' Parse a
pa Parse b
pb = forall a b c sep.
(a -> b -> c) -> Parse a -> Parse sep -> Parse b -> Parse c
ignoreSep (,) Parse a
pa (forall a. Parse a -> Parse a
wrapWhitespace Parser GraphvizState ()
parseComma) Parse b
pb
parseComma :: Parse ()
parseComma :: Parser GraphvizState ()
parseComma = Char -> Parse Char
character Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return ()
tryParseList :: (ParseDot a) => Parse [a]
tryParseList :: forall a. ParseDot a => Parse [a]
tryParseList = forall a. Parse [a] -> Parse [a]
tryParseList' forall a. ParseDot a => Parse a
parse
tryParseList' :: Parse [a] -> Parse [a]
tryParseList' :: forall a. Parse [a] -> Parse [a]
tryParseList' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
parseAngled :: Parse a -> Parse a
parseAngled :: forall a. Parse a -> Parse a
parseAngled = forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parse Char
character Char
'<') (Char -> Parse Char
character Char
'>')
parseBraced :: Parse a -> Parse a
parseBraced :: forall a. Parse a -> Parse a
parseBraced = forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parse Char
character Char
'{') (Char -> Parse Char
character Char
'}')
instance ParseDot ColorScheme where
parseUnqt :: Parse ColorScheme
parseUnqt = Bool -> Parse ColorScheme
parseColorScheme Bool
True
parseColorScheme :: Bool -> Parse ColorScheme
parseColorScheme :: Bool -> Parse ColorScheme
parseColorScheme Bool
scs = do ColorScheme
cs <- forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> [Char] -> Parse a
stringRep ColorScheme
X11 [Char]
"X11"
, forall a. a -> [Char] -> Parse a
stringRep ColorScheme
SVG [Char]
"svg"
, BrewerScheme -> ColorScheme
Brewer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
scs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GraphvizStateM m => ColorScheme -> m ()
setColorScheme ColorScheme
cs
forall (m :: * -> *) a. Monad m => a -> m a
return ColorScheme
cs
instance ParseDot BrewerScheme where
parseUnqt :: Parse BrewerScheme
parseUnqt = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BrewerName -> Word8 -> BrewerScheme
BScheme forall a. ParseDot a => Parse a
parseUnqt forall a. ParseDot a => Parse a
parseUnqt
instance ParseDot BrewerName where
parseUnqt :: Parse BrewerName
parseUnqt = forall a. [([Char], a)] -> Parse a
stringValue [ ([Char]
"accent", BrewerName
Accent)
, ([Char]
"blues", BrewerName
Blues)
, ([Char]
"brbg", BrewerName
Brbg)
, ([Char]
"bugn", BrewerName
Bugn)
, ([Char]
"bupu", BrewerName
Bupu)
, ([Char]
"dark2", BrewerName
Dark2)
, ([Char]
"gnbu", BrewerName
Gnbu)
, ([Char]
"greens", BrewerName
Greens)
, ([Char]
"greys", BrewerName
Greys)
, ([Char]
"oranges", BrewerName
Oranges)
, ([Char]
"orrd", BrewerName
Orrd)
, ([Char]
"paired", BrewerName
Paired)
, ([Char]
"pastel1", BrewerName
Pastel1)
, ([Char]
"pastel2", BrewerName
Pastel2)
, ([Char]
"piyg", BrewerName
Piyg)
, ([Char]
"prgn", BrewerName
Prgn)
, ([Char]
"pubugn", BrewerName
Pubugn)
, ([Char]
"pubu", BrewerName
Pubu)
, ([Char]
"puor", BrewerName
Puor)
, ([Char]
"purd", BrewerName
Purd)
, ([Char]
"purples", BrewerName
Purples)
, ([Char]
"rdbu", BrewerName
Rdbu)
, ([Char]
"rdgy", BrewerName
Rdgy)
, ([Char]
"rdpu", BrewerName
Rdpu)
, ([Char]
"rdylbu", BrewerName
Rdylbu)
, ([Char]
"rdylgn", BrewerName
Rdylgn)
, ([Char]
"reds", BrewerName
Reds)
, ([Char]
"set1", BrewerName
Set1)
, ([Char]
"set2", BrewerName
Set2)
, ([Char]
"set3", BrewerName
Set3)
, ([Char]
"spectral", BrewerName
Spectral)
, ([Char]
"ylgnbu", BrewerName
Ylgnbu)
, ([Char]
"ylgn", BrewerName
Ylgn)
, ([Char]
"ylorbr", BrewerName
Ylorbr)
, ([Char]
"ylorrd", BrewerName
Ylorrd)
]