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)