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