{-# LANGUAGE CPP, OverloadedStrings, PatternGuards #-}
{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.GraphViz.Internal.Util
   Description : Internal utility functions
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module defines internal utility functions.
-}
module Data.GraphViz.Internal.Util where

import Data.Char (isAsciiLower, isAsciiUpper, isDigit, ord)

import           Control.Monad       (liftM2)
import           Data.Function       (on)
import           Data.List           (groupBy, sortBy)
import           Data.Maybe          (isJust)
import           Data.Set            (Set)
import qualified Data.Set            as Set
import           Data.Text.Lazy      (Text)
import qualified Data.Text.Lazy      as T
import qualified Data.Text.Lazy.Read as T

#if MIN_VERSION_base(4,8,0)
import Data.Version (Version, makeVersion)
#else
import Data.Version (Version(..))
#endif

-- -----------------------------------------------------------------------------

isIDString :: Text -> Bool
isIDString :: Text -> Bool
isIDString = Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Char
f,Text
os) -> Char -> Bool
frstIDString Char
f Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
restIDString Text
os)
             (Maybe (Char, Text) -> Bool)
-> (Text -> Maybe (Char, Text)) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

-- | First character of a non-quoted 'String' must match this.
frstIDString   :: Char -> Bool
frstIDString :: Char -> Bool
frstIDString Char
c = ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$Char
c) [ Char -> Bool
isAsciiUpper
                          , Char -> Bool
isAsciiLower
                          , Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'_'
                          , (\ Char
x -> Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
128)
                          ]

-- | The rest of a non-quoted 'String' must match this.
restIDString   :: Char -> Bool
restIDString :: Char -> Bool
restIDString Char
c = Char -> Bool
frstIDString Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c

-- | Determine if this String represents a number.  Boolean parameter
--   determines if exponents are considered part of numbers for this.
isNumString     :: Bool -> Text -> Bool
isNumString :: Bool -> Text -> Bool
isNumString Bool
_      Text
""  = Bool
False
isNumString Bool
_      Text
"-" = Bool
False
isNumString Bool
allowE Text
str = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
str of
                           Just (Char
'-',Text
str') -> Text -> Bool
go Text
str'
                           Maybe (Char, Text)
_               -> Text -> Bool
go Text
str
  where
    -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all
    -- possible cases
    go :: Text -> Bool
go Text
s = (Text -> Text -> Bool) -> (Text, Text) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Bool
go' ((Text, Text) -> Bool) -> (Text, Text) -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit Text
s
    go' :: Text -> Text -> Bool
go' Text
ds Text
nds
      | Text -> Bool
T.null Text
nds = Bool
True
      | Text -> Bool
T.null Text
ds Bool -> Bool -> Bool
&& Text
nds Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"." = Bool
False
      | Text -> Bool
T.null Text
ds
      , Just (Char
'.',Text
nds') <- Text -> Maybe (Char, Text)
T.uncons Text
nds
      , Just (Char
d,Text
nds'') <- Text -> Maybe (Char, Text)
T.uncons Text
nds' = Char -> Bool
isDigit Char
d Bool -> Bool -> Bool
&& Text -> Bool
checkEs' Text
nds''
      | Just (Char
'.',Text
nds') <- Text -> Maybe (Char, Text)
T.uncons Text
nds = Text -> Bool
checkEs (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isDigit Text
nds'
      | Text -> Bool
T.null Text
ds = Bool
False
      | Bool
otherwise = Text -> Bool
checkEs Text
nds
    checkEs' :: Text -> Bool
checkEs' Text
s = case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char
'e' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
s of
                   (Text
"", Text
_) -> Bool
False
                   (Text
ds,Text
es) -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds Bool -> Bool -> Bool
&& Text -> Bool
checkEs Text
es
    checkEs :: Text -> Bool
checkEs Text
str' = case Text -> Maybe (Char, Text)
T.uncons Text
str' of
                     Maybe (Char, Text)
Nothing       -> Bool
True
                     Just (Char
'e',Text
ds) -> Bool
allowE Bool -> Bool -> Bool
&& Text -> Bool
isIntString Text
ds
                     Maybe (Char, Text)
_             -> Bool
False

{-
-- | This assumes that 'isNumString' is 'True'.
toDouble     :: Text -> Double
toDouble str = case T.uncons $ T.toLower str of
                 Just ('-', str') -> toD $ '-' `T.cons` adj str'
                 _                -> toD $ adj str
  where
    adj s = T.cons '0'
            $ case T.span ('.' ==) s of
                (ds, ".") | not $ T.null ds -> s `T.snoc` '0'
                (ds, ds') | Just ('.',es) <- T.uncons ds'
                          , Just ('e',es') <- T.uncons es
                            -> ds `T.snoc` '.' `T.snoc` '0'
                                   `T.snoc` 'e' `T.snoc` '0' `T.append` es'
                _         -> s
    toD = either (const $ error "Not a Double") fst . T.signed T.double
-}
-- | This assumes that 'isNumString' is 'True'.
toDouble     :: Text -> Double
toDouble :: Text -> Double
toDouble Text
str = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
str of
                 Just (Char
'-', Text
str') -> Text -> Double
toD (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ Char
'-' Char -> Text -> Text
`T.cons` Text -> Text
adj Text
str'
                 Maybe (Char, Text)
_                -> Text -> Double
toD (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Text
adj Text
str
  where
    adj :: Text -> Text
adj Text
s = Char -> Text -> Text
T.cons Char
'0'
            (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> Text -> (Text, Text)
T.span (Char
'.' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
s of
                (Text
ds, Text
".") | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
ds -> Text
s Text -> Char -> Text
`T.snoc` Char
'0'
                (Text
ds, Text
ds') | Just (Char
'.',Text
es) <- Text -> Maybe (Char, Text)
T.uncons Text
ds'
                          , Just (Char
'e',Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
es
                            -> Text
ds Text -> Char -> Text
`T.snoc` Char
'.' Text -> Char -> Text
`T.snoc` Char
'0' Text -> Text -> Text
`T.append` Text
es
                (Text, Text)
_              -> Text
s
    toD :: Text -> Double
toD = String -> Double
forall a. Read a => String -> a
read (String -> Double) -> (Text -> String) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

isIntString :: Text -> Bool
isIntString :: Text -> Bool
isIntString = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Text -> Maybe Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
stringToInt

-- | Determine if this String represents an integer.
stringToInt     :: Text -> Maybe Int
stringToInt :: Text -> Maybe Int
stringToInt Text
str = case Reader Int -> Reader Int
forall a. Num a => Reader a -> Reader a
T.signed Reader Int
forall a. Integral a => Reader a
T.decimal Text
str of
                       Right (Int
n, Text
"") -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                       Either String (Int, Text)
_             -> Maybe Int
forall a. Maybe a
Nothing

-- | Graphviz requires double quotes to be explicitly escaped.
escapeQuotes           :: String -> String
escapeQuotes :: String -> String
escapeQuotes []        = []
escapeQuotes (Char
'"':String
str) = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeQuotes String
str
escapeQuotes (Char
c:String
str)   = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeQuotes String
str

-- | Remove explicit escaping of double quotes.
descapeQuotes                :: String -> String
descapeQuotes :: String -> String
descapeQuotes []             = []
descapeQuotes (Char
'\\':Char
'"':String
str) = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
descapeQuotes String
str
descapeQuotes (Char
c:String
str)        = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
descapeQuotes String
str

isKeyword :: Text -> Bool
isKeyword :: Text -> Bool
isKeyword = (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
keywords) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower

-- | The following are Dot keywords and are not valid as labels, etc. unquoted.
keywords :: Set Text
keywords :: Set Text
keywords = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [ Text
"node"
                        , Text
"edge"
                        , Text
"graph"
                        , Text
"digraph"
                        , Text
"subgraph"
                        , Text
"strict"
                        ]

createVersion :: [Int] -> Version
#if MIN_VERSION_base(4,8,0)
createVersion :: [Int] -> Version
createVersion = [Int] -> Version
makeVersion
#else
createVersion bs = Version { versionBranch = bs, versionTags = []}
#endif

-- -----------------------------------------------------------------------------

uniq :: (Ord a) => [a] -> [a]
uniq :: forall a. Ord a => [a] -> [a]
uniq = (a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqBy a -> a
forall a. a -> a
id

uniqBy   :: (Ord b) => (a -> b) -> [a] -> [a]
uniqBy :: forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqBy a -> b
f = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. HasCallStack => [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [[a]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy a -> b
f

groupSortBy   :: (Ord b) => (a -> b) -> [a] -> [[a]]
groupSortBy :: forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy a -> b
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

groupSortCollectBy     :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]
groupSortCollectBy :: forall b a c. Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, [c])]
groupSortCollectBy a -> b
f a -> c
g = ([a] -> (b, [c])) -> [[a]] -> [(b, [c])]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> [c] -> (b, [c]))
-> ([a] -> b) -> ([a] -> [c]) -> [a] -> (b, [c])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (a -> b
f (a -> b) -> ([a] -> a) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. HasCallStack => [a] -> a
head) ((a -> c) -> [a] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map a -> c
g)) ([[a]] -> [(b, [c])]) -> ([a] -> [[a]]) -> [a] -> [(b, [c])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [[a]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortBy a -> b
f

-- | Fold over 'Bool's; first param is for 'False', second for 'True'.
bool       :: a -> a -> Bool -> a
bool :: forall a. a -> a -> Bool -> a
bool a
f a
t Bool
b = if Bool
b
             then a
t
             else a
f

isSingle     :: [a] -> Bool
isSingle :: forall a. [a] -> Bool
isSingle [a
_] = Bool
True
isSingle [a]
_   = Bool
False