{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}

{- |
   Module      : Data.GraphViz.Parsing
   Description : Helper functions for Parsing.
   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module defines simple helper functions for use with
   "Text.ParserCombinators.Poly.Lazy".

   Note that the 'ParseDot' instances for 'Bool', etc. match those
   specified for use with Graphviz (e.g. non-zero integers are
   equivalent to 'True').

   You should not be using this module; rather, it is here for
   informative/documentative reasons.  If you want to parse a
   @'Data.GraphViz.Types.DotRepr'@, you should use
   @'Data.GraphViz.Types.parseDotGraph'@ rather than its 'ParseDot'
   instance.
-}
module Data.GraphViz.Parsing
    ( -- * Re-exporting pertinent parts of Polyparse.
      module Text.ParserCombinators.Poly.StateText
      -- * The ParseDot class.
    , Parse
    , ParseDot(..)
    , parseIt
    , parseIt'
    , runParser
    , runParser'
    , runParserWith
    , parseLiberally
    , checkValidParse
    , checkValidParseWithRest
      -- * Convenience parsing combinators.
    , 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

-- To avoid orphan instances and cyclic imports
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)

-- -----------------------------------------------------------------------------
-- Based off code from Text.Parse in the polyparse library

-- | A @ReadS@-like type alias.
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 = (GraphvizState -> GraphvizState)
-> Parse a -> Text -> (Either [Char] a, Text)
forall a.
(GraphvizState -> GraphvizState)
-> Parse a -> Text -> (Either [Char] a, Text)
runParserWith GraphvizState -> GraphvizState
forall a. a -> a
id

parseLiberally    :: GraphvizState -> GraphvizState
parseLiberally :: GraphvizState -> GraphvizState
parseLiberally GraphvizState
gs = GraphvizState
gs { parseStrictly = 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') = Parse a
-> GraphvizState -> Text -> (Either [Char] a, GraphvizState, Text)
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')

-- | A variant of 'runParser' where it is assumed that the provided
--   parsing function consumes all of the 'Text' input (with the
--   exception of whitespace at the end).
runParser'   :: Parse a -> Text -> a
runParser' :: forall a. Parse a -> Text -> a
runParser' Parse a
p = (Either [Char] a, Text) -> a
forall a. (Either [Char] a, Text) -> a
checkValidParseWithRest ((Either [Char] a, Text) -> a)
-> (Text -> (Either [Char] a, Text)) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a -> Text -> (Either [Char] a, Text)
forall a. Parse a -> Text -> (Either [Char] 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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
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 Char
'[')
                             ( 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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser GraphvizState Char
character Char
']')
                             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

-- | Parse the required value, returning also the rest of the input
--   'Text' that hasn't been parsed (for debugging purposes).
parseIt :: (ParseDot a) => Text -> (a, Text)
parseIt :: forall a. ParseDot a => Text -> (a, Text)
parseIt = (Either [Char] a -> a) -> (Either [Char] a, Text) -> (a, Text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Either [Char] a -> a
forall a. Either [Char] a -> a
checkValidParse ((Either [Char] a, Text) -> (a, Text))
-> (Text -> (Either [Char] a, Text)) -> Text -> (a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a -> Text -> (Either [Char] a, Text)
forall a. Parse a -> Text -> (Either [Char] a, Text)
runParser Parse a
forall a. ParseDot a => Parse a
parse

-- | If unable to parse /Dot/ code properly, 'throw' a
--   'GraphvizException'.
checkValidParse :: Either String a -> a
checkValidParse :: forall a. Either [Char] a -> a
checkValidParse (Left [Char]
err) = GraphvizException -> a
forall a e. Exception e => e -> a
throw ([Char] -> GraphvizException
NotDotCode [Char]
err)
checkValidParse (Right a
a)  = a
a

-- | If unable to parse /Dot/ code properly, 'throw' a
--   'GraphvizException', with the error containing the remaining
--   unparsed code..
checkValidParseWithRest :: (Either String a, Text) -> a
checkValidParseWithRest :: forall a. (Either [Char] a, Text) -> a
checkValidParseWithRest (Left [Char]
err, Text
rst) = GraphvizException -> a
forall a e. Exception e => e -> a
throw ([Char] -> GraphvizException
NotDotCode [Char]
err')
  where
    err' :: [Char]
err' = [Char]
err [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\nRemaining input:\n\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
rst
checkValidParseWithRest (Right a
a,Text
_)     = a
a

-- | Parse the required value with the assumption that it will parse
--   all of the input 'Text'.
parseIt' :: (ParseDot a) => Text -> a
parseIt' :: forall a. ParseDot a => 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 a.
Parser GraphvizState a
-> Parser GraphvizState a -> Parser GraphvizState a
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 Char
':')

  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 a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 = Int
0

-- | Use this when you do not want numbers to be treated as 'Bool' values.
onlyBool :: Parse Bool
onlyBool :: Parse Bool
onlyBool = [Parse Bool] -> Parse Bool
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Bool -> [Char] -> Parse Bool
forall a. a -> [Char] -> Parse a
stringRep Bool
True [Char]
"true"
                 , Bool -> [Char] -> Parse Bool
forall a. a -> [Char] -> Parse a
stringRep Bool
False [Char]
"false"
                 ]

instance ParseDot Char where
  -- Can't be a quote character.
  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 [Char]
parseUnqtList = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser GraphvizState Text -> Parse [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt

  parseList :: Parse [Char]
parseList = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser GraphvizState Text -> Parse [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState Text
forall a. ParseDot a => Parse a
parse

-- | Ignores 'versionTags' and assumes 'not . null . versionBranch'
--   (usually you want 'length . versionBranch == 2') and that all
--   such values are non-negative.
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 Char
'.')

  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 a.
Parser GraphvizState a
-> Parser GraphvizState a -> Parser GraphvizState a
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 a b.
Parser GraphvizState (a -> b)
-> Parser GraphvizState a -> Parser GraphvizState b
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 Char
'.' Parser GraphvizState Char -> Parse Int -> Parse Int
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Int
forall a. Integral a => Parse a
parseInt)
             -- Leave the last one to check for possible decimals
             -- afterwards as there should be at most two version
             -- numbers here.

instance ParseDot Text where
  -- Too many problems with using this within other parsers where
  -- using numString or stringBlock will cause a parse failure.  As
  -- such, this will successfully parse all un-quoted Texts.
  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`
          -- This will also take care of quoted versions of
          -- above.
          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

-- | Parse a 'Text' that doesn't need to be quoted.
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 Bool
q = (Double -> Text) -> Parse Double -> Parser GraphvizState Text
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 :: forall a. Show a => a -> Text
tShow = [Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

stringBlock :: Parse Text
stringBlock :: Parser GraphvizState Text
stringBlock = (Char -> Text -> Text)
-> Parser GraphvizState Char
-> Parser GraphvizState Text
-> Parser GraphvizState Text
forall a b c.
(a -> b -> c)
-> Parser GraphvizState a
-> Parser GraphvizState b
-> Parser GraphvizState c
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)

-- | Used when quotes are explicitly required;
quotedString :: Parse Text
quotedString :: Parser GraphvizState Text
quotedString = Bool -> [Char] -> [Char] -> Parser GraphvizState 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 -> Parser GraphvizState Char
character Char
'-' Parser GraphvizState Char -> Parse a -> Parse a
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Parse a -> Parse a
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 :: forall a. Integral a => Parse a
parseInt = Bool -> Parse a
forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
True

-- | Flag indicates whether to check whether the number is actually a
--   floating-point value.
parseIntCheck    :: (Integral a) => Bool -> Parse a
parseIntCheck :: forall a. Integral a => Bool -> Parse a
parseIntCheck Bool
ch = do Text
cs <- (Char -> Bool) -> Parser GraphvizState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isDigit
                            Parser GraphvizState Text
-> ([Char] -> [Char]) -> Parser GraphvizState Text
forall a.
Parser GraphvizState a
-> ([Char] -> [Char]) -> Parser GraphvizState a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Expected one or more digits\n\t"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
                      case Reader a
forall a. Integral a => Reader a
T.decimal Text
cs of
                        Right (a
n,Text
"")  -> (a -> Parse a) -> (a -> Parse a) -> Bool -> a -> Parse a
forall a. a -> a -> Bool -> a
bool a -> Parse a
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return a -> Parse a
forall a. a -> Parser GraphvizState a
checkInt Bool
ch a
n
                        -- This case should never actually happen...
                        Right (a
_,Text
txt) -> [Char] -> Parse a
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parse a) -> [Char] -> Parse a
forall a b. (a -> b) -> a -> b
$ [Char]
"Trailing digits not parsed as Integral: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
txt
                        Left [Char]
err      -> [Char] -> Parse a
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parse a) -> [Char] -> Parse a
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read Integral: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
  where
    checkInt :: b -> Parser GraphvizState b
checkInt 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
'.', Char -> Parser GraphvizState Char
character Char
'e' ]
                    if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
c
                      then [Char] -> Parser GraphvizState b
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"This number is actually Floating, not Integral!"
                      else b -> Parser GraphvizState b
forall a. a -> Parser GraphvizState a
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

-- | Parse a floating point number that actually contains decimals.
--   Bool flag indicates whether values that need to be quoted are
--   parsed.
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

-- | Bool flag indicates whether to allow parsing exponentiated term,
-- as this is only allowed when quoted.
parseFloat :: (RealFrac a) => Bool -> Parse a
parseFloat :: forall a. RealFrac a => Bool -> Parse a
parseFloat 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 Char
'.' Parser GraphvizState Char
-> Parser GraphvizState Text -> Parser GraphvizState Text
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
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)
                    ([Char] -> Parser GraphvizState ()
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 a. a -> Parser GraphvizState a
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)
                    ([Char] -> Parser GraphvizState ()
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"This is an integer, not a floating point number!")
                  let frac' :: Text
frac' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
frac
                      expn' :: Int
expn' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
expn
                  ( a -> Parser GraphvizState a
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parser GraphvizState a)
-> (Text -> a) -> Text -> Parser GraphvizState 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
* (Rational
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
%Integer
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')
               Parser GraphvizState a
-> Parser GraphvizState a -> Parser GraphvizState a
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
               [Char] -> Parser GraphvizState a
forall a. [Char] -> Parser GraphvizState a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected a floating point number"
  where
    parseExp :: Parse Int
parseExp = Char -> Parser GraphvizState Char
character Char
'e'
               Parser GraphvizState Char -> Parse Int -> Parse Int
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Char -> Parser GraphvizState Char
character Char
'+' Parser GraphvizState Char -> Parse Int -> Parse Int
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
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

-- Bool indicates whether we can parse values that need quotes.
parseSignedFloat :: Bool -> Parse Double
parseSignedFloat :: Bool -> Parse Double
parseSignedFloat 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 a.
Parser GraphvizState a
-> Parser GraphvizState a -> Parser GraphvizState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Double) -> Parse Integer -> Parse Double
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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 :: forall a. Parse a -> Parse a
parseAndSpace 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 :: [Char] -> Parser GraphvizState ()
string = (Char -> Parser GraphvizState Char)
-> [Char] -> 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 :: forall a. a -> [Char] -> Parse a
stringRep a
v = a -> [[Char]] -> Parse a
forall a. a -> [[Char]] -> Parse a
stringReps a
v ([[Char]] -> Parse a) -> ([Char] -> [[Char]]) -> [Char] -> Parse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
forall a. a -> [a]
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 = [Parser GraphvizState ()] -> Parser GraphvizState ()
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf (([Char] -> Parser GraphvizState ())
-> [[Char]] -> [Parser GraphvizState ()]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Parser GraphvizState ()
string [[Char]]
ss) Parser GraphvizState ()
-> Parser GraphvizState a -> Parser GraphvizState a
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Parser GraphvizState a
forall a. a -> Parser GraphvizState a
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 = [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
forall a. [([Char], Parse a)] -> Parse a
toPM ([([Char], Parser GraphvizState a)] -> Parser GraphvizState a)
-> ([([Char], Parser GraphvizState a)]
    -> [([Char], Parser GraphvizState a)])
-> [([Char], Parser GraphvizState a)]
-> Parser GraphvizState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], Parser GraphvizState a)
 -> ([Char], Parser GraphvizState a) -> Ordering)
-> [([Char], Parser GraphvizState a)]
-> [([Char], Parser GraphvizState a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (([Char] -> [Char] -> Ordering) -> [Char] -> [Char] -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (([Char], Parser GraphvizState a) -> [Char])
-> ([Char], Parser GraphvizState a)
-> ([Char], Parser GraphvizState a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Char], Parser GraphvizState a) -> [Char]
forall a b. (a, b) -> a
fst)
  where
    toPM :: [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
toPM = [Parser GraphvizState a] -> Parser GraphvizState a
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf ([Parser GraphvizState a] -> Parser GraphvizState a)
-> ([([Char], Parser GraphvizState a)] -> [Parser GraphvizState a])
-> [([Char], Parser GraphvizState a)]
-> Parser GraphvizState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([Char], Parser GraphvizState a)] -> Parser GraphvizState a)
-> [[([Char], Parser GraphvizState a)]] -> [Parser GraphvizState a]
forall a b. (a -> b) -> [a] -> [b]
map [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
mkPM ([[([Char], Parser GraphvizState a)]] -> [Parser GraphvizState a])
-> ([([Char], Parser GraphvizState a)]
    -> [[([Char], Parser GraphvizState a)]])
-> [([Char], Parser GraphvizState a)]
-> [Parser GraphvizState a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], Parser GraphvizState a)
 -> ([Char], Parser GraphvizState a) -> Bool)
-> [([Char], Parser GraphvizState a)]
-> [[([Char], Parser GraphvizState a)]]
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)
-> (([Char], Parser GraphvizState a) -> Maybe Char)
-> ([Char], Parser GraphvizState a)
-> ([Char], Parser GraphvizState a)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Char] -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe ([Char] -> Maybe Char)
-> (([Char], Parser GraphvizState a) -> [Char])
-> ([Char], Parser GraphvizState a)
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Parser GraphvizState a) -> [Char]
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 Parser GraphvizState ()
-> Parser GraphvizState a -> Parser GraphvizState a
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState a
p
    mkPM [([Char], Parser GraphvizState a)]
kv = Char -> Parser GraphvizState Char
character ([Char] -> Char
forall a. HasCallStack => [a] -> a
head ([Char] -> Char)
-> (([Char], Parser GraphvizState a) -> [Char])
-> ([Char], Parser GraphvizState a)
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Parser GraphvizState a) -> [Char]
forall a b. (a, b) -> a
fst (([Char], Parser GraphvizState a) -> Char)
-> ([Char], Parser GraphvizState a) -> Char
forall a b. (a -> b) -> a -> b
$ [([Char], Parser GraphvizState a)]
-> ([Char], Parser GraphvizState a)
forall a. HasCallStack => [a] -> a
head [([Char], Parser GraphvizState a)]
kv) Parser GraphvizState Char
-> Parser GraphvizState a -> Parser GraphvizState a
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [([Char], Parser GraphvizState a)] -> Parser GraphvizState a
toPM ((([Char], Parser GraphvizState a)
 -> ([Char], Parser GraphvizState a))
-> [([Char], Parser GraphvizState a)]
-> [([Char], Parser GraphvizState a)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char])
-> ([Char], Parser GraphvizState a)
-> ([Char], Parser GraphvizState a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail) [([Char], Parser GraphvizState a)]
kv)

stringValue :: [(String, a)] -> Parse a
stringValue :: forall a. [([Char], a)] -> Parse a
stringValue = [([Char], Parse a)] -> Parse a
forall a. [([Char], Parse a)] -> Parse a
stringParse ([([Char], Parse a)] -> Parse a)
-> ([([Char], a)] -> [([Char], Parse a)])
-> [([Char], a)]
-> Parse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], a) -> ([Char], Parse a))
-> [([Char], a)] -> [([Char], Parse a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Parse a) -> ([Char], a) -> ([Char], Parse a)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> Parse a
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return)

strings :: [String] -> Parse ()
strings :: [[Char]] -> Parser GraphvizState ()
strings = [Parser GraphvizState ()] -> Parser GraphvizState ()
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf ([Parser GraphvizState ()] -> Parser GraphvizState ())
-> ([[Char]] -> [Parser GraphvizState ()])
-> [[Char]]
-> Parser GraphvizState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Parser GraphvizState ())
-> [[Char]] -> [Parser GraphvizState ()]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Parser GraphvizState ()
string

-- | Assumes that any letter is ASCII for case-insensitive
--   comparisons.
character   :: Char -> Parse Char
character :: Char -> Parser GraphvizState Char
character Char
c = (Char -> Bool) -> Parser GraphvizState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
parseC
              Parser GraphvizState Char
-> ([Char] -> [Char]) -> Parser GraphvizState Char
forall a.
Parser GraphvizState a
-> ([Char] -> [Char]) -> Parser GraphvizState a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr`
              ([Char] -> [Char] -> [Char]
forall a b. a -> b -> a
const ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Not the expected character: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c])
  where
    parseC :: Char -> Bool
parseC 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 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] -> Parser GraphvizState Char
noneOf [Char]
t = (Char -> Bool) -> Parser GraphvizState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (\Char
x -> (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
x) [Char]
t)

-- | Parses at least one whitespace character.
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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Parses zero or more whitespace characters.
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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Parse and discard optional surrounding whitespace.
wrapWhitespace :: Parse a -> Parse a
wrapWhitespace :: forall a. Parse a -> Parse a
wrapWhitespace = Parser GraphvizState ()
-> Parser GraphvizState ()
-> Parser GraphvizState a
-> Parser GraphvizState 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 :: [Char] -> Parser GraphvizState ()
optionalQuotedString = Parser GraphvizState () -> Parser GraphvizState ()
forall a. Parse a -> Parse a
optionalQuoted (Parser GraphvizState () -> Parser GraphvizState ())
-> ([Char] -> Parser GraphvizState ())
-> [Char]
-> Parser GraphvizState ()
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 = 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 :: forall a. Parse a -> Parse a
quotedParse = Parser GraphvizState ()
-> Parser GraphvizState ()
-> Parser GraphvizState a
-> Parser GraphvizState 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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

orQuote   :: Parse Char -> Parse Char
orQuote :: Parser GraphvizState Char -> Parser GraphvizState Char
orQuote Parser GraphvizState Char
p = Char -> [Char] -> Parser GraphvizState Char
forall a. a -> [Char] -> Parse a
stringRep Char
quoteChar [Char]
"\\\""
            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 = Char
'"'

-- | Parse a 'Text' where the provided 'Char's (as well as @\"@ and
--   @\\@) are escaped and the second list of 'Char's are those that
--   are not permitted.  Note: does not parse surrounding quotes.  The
--   'Bool' value indicates whether empty 'Text's are allowed or not.
parseEscaped             :: Bool -> [Char] -> [Char] -> Parse Text
parseEscaped :: Bool -> [Char] -> [Char] -> Parser GraphvizState Text
parseEscaped Bool
empt [Char]
cs [Char]
bnd = ([Char] -> Text) -> Parse [Char] -> Parser GraphvizState Text
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack (Parse [Char] -> Parser GraphvizState Text)
-> (Parser GraphvizState Char -> Parse [Char])
-> Parser GraphvizState Char
-> Parser GraphvizState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser GraphvizState Char -> Parse [Char]
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 {a}. 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' :: [Char]
cs' = Char
quoteChar Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
slash Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs
    csSet :: Set Char
csSet = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
cs'
    bndSet :: Set Char
bndSet = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
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 = Char
'\\'
    -- Have to allow standard slashes
    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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
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)
-> [Char] -> [Parser GraphvizState Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Parser GraphvizState Char
character [Char]
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)

-- | Parses a newline.
newline :: Parse ()
newline :: Parser GraphvizState ()
newline = [[Char]] -> Parser GraphvizState ()
strings [[Char]
"\r\n", [Char]
"\n", [Char]
"\r"]

-- | Consume all whitespace and newlines until a line with
--   non-whitespace is reached.  The whitespace on that line is
--   not consumed.
newline' :: Parse ()
newline' :: Parser GraphvizState ()
newline' = Parser GraphvizState () -> Parser GraphvizState [()]
forall {a}. Parser GraphvizState a -> Parser GraphvizState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser GraphvizState ()
whitespace Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
newline) Parser GraphvizState [()]
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Parses and returns all characters up till the end of the line,
--   but does not touch the newline characters.
consumeLine :: Parse Text
consumeLine :: Parser GraphvizState Text
consumeLine = (Char -> Bool) -> Parser GraphvizState Text
forall s. (Char -> Bool) -> Parser s Text
manySatisfy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n',Char
'\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 Char
'=') Parser GraphvizState Char
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The opposite of 'bracket'.
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 (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 a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parse sep
sep Parser GraphvizState (b -> c) -> Parse b -> Parser GraphvizState c
forall a b.
Parser GraphvizState (a -> b)
-> Parser GraphvizState a -> Parser GraphvizState b
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 = 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 :: forall a b. (ParseDot a, ParseDot b) => 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' :: forall a b. Parse a -> Parse b -> Parse (a, b)
commaSep' Parse a
pa 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 Char
',' Parser GraphvizState Char
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser GraphvizState ()
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Try to parse a list of the specified type; returns an empty list
--   if parsing fails.
tryParseList :: (ParseDot a) => Parse [a]
tryParseList :: forall a. ParseDot a => Parse [a]
tryParseList = Parse [a] -> Parse [a]
forall a. Parse [a] -> Parse [a]
tryParseList' Parse [a]
forall a. ParseDot a => Parse a
parse

-- | Return an empty list if parsing a list fails.
tryParseList' :: Parse [a] -> Parse [a]
tryParseList' :: forall a. Parse [a] -> Parse [a]
tryParseList' = (Maybe [a] -> [a])
-> Parser GraphvizState (Maybe [a]) -> Parser GraphvizState [a]
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
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]) -> Parser GraphvizState [a])
-> (Parser GraphvizState [a] -> Parser GraphvizState (Maybe [a]))
-> Parser GraphvizState [a]
-> Parser GraphvizState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser GraphvizState [a] -> Parser GraphvizState (Maybe [a])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional

parseAngled :: Parse a -> Parse a
parseAngled :: forall a. Parse a -> Parse a
parseAngled = Parser GraphvizState Char
-> Parser GraphvizState Char
-> Parser GraphvizState a
-> Parser GraphvizState a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parser GraphvizState Char
character Char
'<') (Char -> Parser GraphvizState Char
character Char
'>')

parseBraced :: Parse a -> Parse a
parseBraced :: forall a. Parse a -> Parse a
parseBraced = Parser GraphvizState Char
-> Parser GraphvizState Char
-> Parser GraphvizState a
-> Parser GraphvizState a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parser GraphvizState Char
character Char
'{') (Char -> Parser GraphvizState Char
character Char
'}')

-- -----------------------------------------------------------------------------
-- These instances are defined here to avoid cyclic imports and orphan instances

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 <- [Parse ColorScheme] -> Parse ColorScheme
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ ColorScheme -> [Char] -> Parse ColorScheme
forall a. a -> [Char] -> Parse a
stringRep ColorScheme
X11 [Char]
"X11"
                                      , ColorScheme -> [Char] -> Parse ColorScheme
forall a. a -> [Char] -> Parse a
stringRep ColorScheme
SVG [Char]
"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 a. a -> Parser GraphvizState a
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 a b c.
(a -> b -> c)
-> Parser GraphvizState a
-> Parser GraphvizState b
-> Parser GraphvizState c
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
  -- The order is different from above to make sure longer names are
  -- parsed first.
  parseUnqt :: Parser GraphvizState BrewerName
parseUnqt = [([Char], BrewerName)] -> Parser GraphvizState BrewerName
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)
                          ]