-- | <http://www.tcs.hut.fi/Software/bliss/fileformat.shtml>
module Music.Theory.Graph.Bliss where

import qualified Music.Theory.Graph.Type as T {- hmt-base -}

-- | Problem is (n-vertices,n-edges)
bliss_parse_problem :: String -> (Int,Int)
bliss_parse_problem :: String -> (Int, Int)
bliss_parse_problem String
txt =
  case String -> [String]
words String
txt of
    [String
"p",String
"edge",String
n,String
e] -> (forall a. Read a => String -> a
read String
n,forall a. Read a => String -> a
read String
e)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"bliss_parse_problem"

-- | Vertex colour is (vertex,colour)
bliss_parse_vertex_colour :: String -> (Int,Int)
bliss_parse_vertex_colour :: String -> (Int, Int)
bliss_parse_vertex_colour String
txt =
  case String -> [String]
words String
txt of
    [String
"n",String
v,String
e] -> (forall a. Read a => String -> a
read String
v,forall a. Read a => String -> a
read String
e)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"bliss_parse_vertex_color"

-- | Edge is (vertex,vertex)
bliss_parse_edge :: String -> (Int,Int)
bliss_parse_edge :: String -> (Int, Int)
bliss_parse_edge String
txt =
  case String -> [String]
words String
txt of
    [String
"e",String
v1,String
v2] -> (forall a. Read a => String -> a
read String
v1,forall a. Read a => String -> a
read String
v2)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"bliss_parse_edge"

-- | (problem,vertex-colours,edges)
--   Bliss data is one-indexed.
type Bliss = ((Int,Int), [(Int,Int)], [(Int,Int)])

-- | Parse 'Bliss'
bliss_parse :: String -> Bliss
bliss_parse :: String -> Bliss
bliss_parse String
txt =
  let c0_is :: b -> [b] -> Bool
c0_is b
x = (forall a. Eq a => a -> a -> Bool
== b
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head
      ln :: [String]
ln = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall {b}. Eq b => b -> [b] -> Bool
c0_is Char
'c') (String -> [String]
lines String
txt) -- c = comment
      ([String
p],[String]
r1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall {b}. Eq b => b -> [b] -> Bool
c0_is Char
'p') [String]
ln -- p = problem
      ([String]
n,[String]
r2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall {b}. Eq b => b -> [b] -> Bool
c0_is Char
'n') [String]
r1 -- n = vertex colour
      ([String]
e,[String]
_) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall {b}. Eq b => b -> [b] -> Bool
c0_is Char
'e') [String]
r2 -- e = edge
  in (String -> (Int, Int)
bliss_parse_problem String
p,forall a b. (a -> b) -> [a] -> [b]
map String -> (Int, Int)
bliss_parse_vertex_colour [String]
n,forall a b. (a -> b) -> [a] -> [b]
map String -> (Int, Int)
bliss_parse_edge [String]
e)

-- | 'bliss_parse' of 'readFile'
bliss_load :: FilePath -> IO Bliss
bliss_load :: String -> IO Bliss
bliss_load = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Bliss
bliss_parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | 'Bliss' (one-indexed) to 'T.G' (zero-indexed)
bliss_to_g :: Bliss -> T.G
bliss_to_g :: Bliss -> G
bliss_to_g ((Int
k,Int
_),[(Int, Int)]
_,[(Int, Int)]
e) = ([Int
0 .. Int
k forall a. Num a => a -> a -> a
- Int
1],forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,Int
j) -> (Int
i forall a. Num a => a -> a -> a
- Int
1,Int
j forall a. Num a => a -> a -> a
- Int
1)) [(Int, Int)]
e)