module HGraph.Directed.Load ( loadDot , loadEdgeList ) where import HGraph.Directed import HGraph.Utils import qualified Language.Dot.Parser as D import qualified Language.Dot.Utils as D import qualified Language.Dot.Graph as D import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe import Text.Read loadDot :: t Int -> [Char] -> Either [Char] (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) loadDot t Int emptyD [Char] dotStr = do (Bool, GraphType, Maybe Name, [Statement]) dot <- [Char] -> Either [Char] (Bool, GraphType, Maybe Name, [Statement]) D.parse [Char] dotStr (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) -> Either [Char] (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) forall (m :: * -> *) a. Monad m => a -> m a return ((t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) -> Either [Char] (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)])) -> (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) -> Either [Char] (t Int, Map [Char] Int, Map Int [Char], Map [Char] [(Name, Name)], Map ([Char], [Char]) [(Name, Name)]) forall a b. (a -> b) -> a -> b $ let ([GraphElement] ns, [GraphElement] es) = (Bool, GraphType, Maybe Name, [Statement]) -> ([GraphElement], [GraphElement]) forall a b c. (a, b, c, [Statement]) -> ([GraphElement], [GraphElement]) D.adjacency (Bool, GraphType, Maybe Name, [Statement]) dot names :: [[Char]] names = (Set [Char] -> [[Char]] forall a. Set a -> [a] S.toList (Set [Char] -> [[Char]]) -> Set [Char] -> [[Char]] forall a b. (a -> b) -> a -> b $ [[Char]] -> Set [Char] forall a. Ord a => [a] -> Set a S.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char] forall a b. (a -> b) -> a -> b $ (GraphElement -> [Char]) -> [GraphElement] -> [[Char]] forall a b. (a -> b) -> [a] -> [b] map GraphElement -> [Char] getNodeName [GraphElement] ns) nid :: Map [Char] Int nid = [([Char], Int)] -> Map [Char] Int forall k a. Ord k => [(k, a)] -> Map k a M.fromList ([([Char], Int)] -> Map [Char] Int) -> [([Char], Int)] -> Map [Char] Int forall a b. (a -> b) -> a -> b $ [[Char]] -> [Int] -> [([Char], Int)] forall a b. [a] -> [b] -> [(a, b)] zip [[Char]] names ([Int 0..] :: [Int]) idToStr :: Map Int [Char] idToStr = [(Int, [Char])] -> Map Int [Char] forall k a. Ord k => [(k, a)] -> Map k a M.fromList ([(Int, [Char])] -> Map Int [Char]) -> [(Int, [Char])] -> Map Int [Char] forall a b. (a -> b) -> a -> b $ [Int] -> [[Char]] -> [(Int, [Char])] forall a b. [a] -> [b] -> [(a, b)] zip ([Int 0..] :: [Int]) [[Char]] names addEdge :: GraphElement -> t Int -> t Int addEdge (D.Edge [Char] v [Char] u [(Name, Name)] _) t Int d = (Int, Int) -> t Int -> t Int forall (t :: * -> *) a. Mutable t => (a, a) -> t a -> t a addArc (Map [Char] Int nid Map [Char] Int -> [Char] -> Int forall k a. Ord k => Map k a -> k -> a M.! [Char] v, Map [Char] Int nid Map [Char] Int -> [Char] -> Int forall k a. Ord k => Map k a -> k -> a M.! [Char] u) t Int d getNodeName :: GraphElement -> [Char] getNodeName (D.Node [Char] name [(Name, Name)] _) = [Char] name nodeAttrMap :: Map [Char] [(Name, Name)] nodeAttrMap = [([Char], [(Name, Name)])] -> Map [Char] [(Name, Name)] forall k a. Ord k => [(k, a)] -> Map k a M.fromList [ ([Char] v, [(Name, Name)] attrs) | D.Node [Char] v [(Name, Name)] attrs <- [GraphElement] ns] edgeAttrMap :: Map ([Char], [Char]) [(Name, Name)] edgeAttrMap = [(([Char], [Char]), [(Name, Name)])] -> Map ([Char], [Char]) [(Name, Name)] forall k a. Ord k => [(k, a)] -> Map k a M.fromList [ (([Char] v,[Char] u), [(Name, Name)] attrs) | D.Edge [Char] v [Char] u [(Name, Name)] attrs <- [GraphElement] es] in ((GraphElement -> t Int -> t Int) -> t Int -> [GraphElement] -> t Int forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr GraphElement -> t Int -> t Int addEdge ((Int -> t Int -> t Int) -> t Int -> [Int] -> t Int forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr Int -> t Int -> t Int forall (t :: * -> *) a. Mutable t => a -> t a -> t a addVertex t Int emptyD ([Int] -> t Int) -> [Int] -> t Int forall a b. (a -> b) -> a -> b $ Map Int [Char] -> [Int] forall k a. Map k a -> [k] M.keys Map Int [Char] idToStr) [GraphElement] es, Map [Char] Int nid, Map Int [Char] idToStr, Map [Char] [(Name, Name)] nodeAttrMap, Map ([Char], [Char]) [(Name, Name)] edgeAttrMap) loadEdgeList :: t a -> [Char] -> Either [Char] (t a) loadEdgeList t a emptyD [Char] dStr | [[Char]] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [[Char]] terms = t a -> Either [Char] (t a) forall (m :: * -> *) a. Monad m => a -> m a return t a emptyD | Bool otherwise = do a nv <- Either [Char] a -> Maybe (Either [Char] a) -> Either [Char] a forall a. a -> Maybe a -> a fromMaybe ([Char] -> Either [Char] a forall a b. a -> Either a b Left [Char] "Invalid number of vertices.") (Maybe (Either [Char] a) -> Either [Char] a) -> Maybe (Either [Char] a) -> Either [Char] a forall a b. (a -> b) -> a -> b $ do [Char] t0 <- [[Char]] -> Maybe [Char] forall a. [a] -> Maybe a mhead [[Char]] terms a n <- [Char] -> Maybe a forall a. Read a => [Char] -> Maybe a readMaybe [Char] t0 if a n a -> a -> Bool forall a. Ord a => a -> a -> Bool < a 1 then Maybe (Either [Char] a) forall a. Maybe a Nothing else Either [Char] a -> Maybe (Either [Char] a) forall (m :: * -> *) a. Monad m => a -> m a return (Either [Char] a -> Maybe (Either [Char] a)) -> Either [Char] a -> Maybe (Either [Char] a) forall a b. (a -> b) -> a -> b $ a -> Either [Char] a forall a b. b -> Either a b Right a n Int ne <- Either [Char] Int -> Maybe (Either [Char] Int) -> Either [Char] Int forall a. a -> Maybe a -> a fromMaybe ([Char] -> Either [Char] Int forall a b. a -> Either a b Left [Char] "Invalid number of edges.") (Maybe (Either [Char] Int) -> Either [Char] Int) -> Maybe (Either [Char] Int) -> Either [Char] Int forall a b. (a -> b) -> a -> b $ do [Char] t0 <- [[Char]] -> Maybe [Char] forall a. [a] -> Maybe a mhead ([[Char]] -> Maybe [Char]) -> [[Char]] -> Maybe [Char] forall a b. (a -> b) -> a -> b $ Int -> [[Char]] -> [[Char]] forall a. Int -> [a] -> [a] drop Int 1 [[Char]] terms Int e <- [Char] -> Maybe Int forall a. Read a => [Char] -> Maybe a readMaybe [Char] t0 if Int e Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 then Maybe (Either [Char] Int) forall a. Maybe a Nothing else Either [Char] Int -> Maybe (Either [Char] Int) forall (m :: * -> *) a. Monad m => a -> m a return (Either [Char] Int -> Maybe (Either [Char] Int)) -> Either [Char] Int -> Maybe (Either [Char] Int) forall a b. (a -> b) -> a -> b $ Int -> Either [Char] Int forall a b. b -> Either a b Right Int e [(a, a)] es <- a -> [[Char]] -> Either [Char] [(a, a)] forall t. (Read t, Integral t) => t -> [[Char]] -> Either [Char] [(t, t)] readEdges a nv ([[Char]] -> Either [Char] [(a, a)]) -> [[Char]] -> Either [Char] [(a, a)] forall a b. (a -> b) -> a -> b $ Int -> [[Char]] -> [[Char]] forall a. Int -> [a] -> [a] drop Int 2 [[Char]] terms if Int ne Int -> Int -> Bool forall a. Eq a => a -> a -> Bool /= ([(a, a)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [(a, a)] es) then [Char] -> Either [Char] (t a) forall a b. a -> Either a b Left ([Char] -> Either [Char] (t a)) -> [Char] -> Either [Char] (t a) forall a b. (a -> b) -> a -> b $ [Char] "Expected " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ (Int -> [Char] forall a. Show a => a -> [Char] show Int ne) [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] " many edges, found " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ (Int -> [Char] forall a. Show a => a -> [Char] show (Int -> [Char]) -> Int -> [Char] forall a b. (a -> b) -> a -> b $ [(a, a)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [(a, a)] es) [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "." else t a -> Either [Char] (t a) forall (m :: * -> *) a. Monad m => a -> m a return (t a -> Either [Char] (t a)) -> t a -> Either [Char] (t a) forall a b. (a -> b) -> a -> b $ ((a, a) -> t a -> t a) -> t a -> [(a, a)] -> t a forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (a, a) -> t a -> t a forall (t :: * -> *) a. Mutable t => (a, a) -> t a -> t a addArc ((a -> t a -> t a) -> t a -> [a] -> t a forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr a -> t a -> t a forall (t :: * -> *) a. Mutable t => a -> t a -> t a addVertex t a emptyD [a 0..a nv a -> a -> a forall a. Num a => a -> a -> a - a 1]) [(a, a)] es where terms :: [[Char]] terms = [Char] -> [[Char]] words [Char] dStr readEdges :: t -> [[Char]] -> Either [Char] [(t, t)] readEdges t _ [] = [(t, t)] -> Either [Char] [(t, t)] forall (m :: * -> *) a. Monad m => a -> m a return [] readEdges t _ [[Char] _] = [Char] -> Either [Char] [(t, t)] forall a b. a -> Either a b Left [Char] "Missing tail of last edge." readEdges t nv ([Char] vStr:[Char] uStr:[[Char]] vs) = do t v <- Either [Char] t -> Maybe (Either [Char] t) -> Either [Char] t forall a. a -> Maybe a -> a fromMaybe ([Char] -> Either [Char] t forall a b. a -> Either a b Left ([Char] -> Either [Char] t) -> [Char] -> Either [Char] t forall a b. (a -> b) -> a -> b $ [Char] "Invalid vertex: " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] vStr) (Maybe (Either [Char] t) -> Either [Char] t) -> Maybe (Either [Char] t) -> Either [Char] t forall a b. (a -> b) -> a -> b $ (t -> Either [Char] t) -> Maybe t -> Maybe (Either [Char] t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap t -> Either [Char] t forall a b. b -> Either a b Right (Maybe t -> Maybe (Either [Char] t)) -> Maybe t -> Maybe (Either [Char] t) forall a b. (a -> b) -> a -> b $ [Char] -> Maybe t forall a. Read a => [Char] -> Maybe a readMaybe [Char] vStr t u <- Either [Char] t -> Maybe (Either [Char] t) -> Either [Char] t forall a. a -> Maybe a -> a fromMaybe ([Char] -> Either [Char] t forall a b. a -> Either a b Left ([Char] -> Either [Char] t) -> [Char] -> Either [Char] t forall a b. (a -> b) -> a -> b $ [Char] "Invalid vertex: " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] uStr) (Maybe (Either [Char] t) -> Either [Char] t) -> Maybe (Either [Char] t) -> Either [Char] t forall a b. (a -> b) -> a -> b $ (t -> Either [Char] t) -> Maybe t -> Maybe (Either [Char] t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap t -> Either [Char] t forall a b. b -> Either a b Right (Maybe t -> Maybe (Either [Char] t)) -> Maybe t -> Maybe (Either [Char] t) forall a b. (a -> b) -> a -> b $ [Char] -> Maybe t forall a. Read a => [Char] -> Maybe a readMaybe [Char] uStr ([(t, t)] -> [(t, t)]) -> Either [Char] [(t, t)] -> Either [Char] [(t, t)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((t v t -> t -> t forall a. Integral a => a -> a -> a `mod` t nv, t u t -> t -> t forall a. Integral a => a -> a -> a `mod` t nv) (t, t) -> [(t, t)] -> [(t, t)] forall a. a -> [a] -> [a] : ) (t -> [[Char]] -> Either [Char] [(t, t)] readEdges t nv [[Char]] vs)