{-# 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 = maybe False (\(f,os) -> frstIDString f && T.all restIDString os) . T.uncons -- | First character of a non-quoted 'String' must match this. frstIDString :: Char -> Bool frstIDString c = any ($c) [ isAsciiUpper , isAsciiLower , (==) '_' , (\ x -> ord x >= 128) ] -- | The rest of a non-quoted 'String' must match this. restIDString :: Char -> Bool restIDString c = frstIDString c || isDigit 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 _ "" = False isNumString _ "-" = False isNumString allowE str = case T.uncons $ T.toLower str of Just ('-',str') -> go str' _ -> go str where -- Can't use Data.Text.Lazy.Read.double as it doesn't cover all -- possible cases go s = uncurry go' $ T.span isDigit s go' ds nds | T.null nds = True | T.null ds && nds == "." = False | T.null ds , Just ('.',nds') <- T.uncons nds , Just (d,nds'') <- T.uncons nds' = isDigit d && checkEs' nds'' | Just ('.',nds') <- T.uncons nds = checkEs $ T.dropWhile isDigit nds' | T.null ds = False | otherwise = checkEs nds checkEs' s = case T.break ('e' ==) s of ("", _) -> False (ds,es) -> T.all isDigit ds && checkEs es checkEs str' = case T.uncons str' of Nothing -> True Just ('e',ds) -> allowE && isIntString ds _ -> 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 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',_) <- T.uncons es -> ds `T.snoc` '.' `T.snoc` '0' `T.append` es _ -> s toD = read . T.unpack isIntString :: Text -> Bool isIntString = isJust . stringToInt -- | Determine if this String represents an integer. stringToInt :: Text -> Maybe Int stringToInt str = case T.signed T.decimal str of Right (n, "") -> Just n _ -> Nothing -- | Graphviz requires double quotes to be explicitly escaped. escapeQuotes :: String -> String escapeQuotes [] = [] escapeQuotes ('"':str) = '\\':'"': escapeQuotes str escapeQuotes (c:str) = c : escapeQuotes str -- | Remove explicit escaping of double quotes. descapeQuotes :: String -> String descapeQuotes [] = [] descapeQuotes ('\\':'"':str) = '"' : descapeQuotes str descapeQuotes (c:str) = c : descapeQuotes str isKeyword :: Text -> Bool isKeyword = (`Set.member` keywords) . T.toLower -- | The following are Dot keywords and are not valid as labels, etc. unquoted. keywords :: Set Text keywords = Set.fromList [ "node" , "edge" , "graph" , "digraph" , "subgraph" , "strict" ] createVersion :: [Int] -> Version #if MIN_VERSION_base(4,8,0) createVersion = makeVersion #else createVersion bs = Version { versionBranch = bs, versionTags = []} #endif -- ----------------------------------------------------------------------------- uniq :: (Ord a) => [a] -> [a] uniq = uniqBy id uniqBy :: (Ord b) => (a -> b) -> [a] -> [a] uniqBy f = map head . groupSortBy f groupSortBy :: (Ord b) => (a -> b) -> [a] -> [[a]] groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f) groupSortCollectBy :: (Ord b) => (a -> b) -> (a -> c) -> [a] -> [(b,[c])] groupSortCollectBy f g = map (liftM2 (,) (f . head) (map g)) . groupSortBy f -- | Fold over 'Bool's; first param is for 'False', second for 'True'. bool :: a -> a -> Bool -> a bool f t b = if b then t else f isSingle :: [a] -> Bool isSingle [_] = True isSingle _ = False