{-|
Module      : ParseBCG
Description : parse bi-coloured graphs
Copyright   : (c) Sebastian Tee, 2022
License     : MIT
Maintainer  : github.com/SebTee

Library for parsing strings into 'BCG.BCG'
-}
module ParseBCG (
    parse,
    ParseException (IncorrectNumberOfParameters, ComplexNumberParseFailure)
) where

import BCG
import Data.Complex
import qualified Data.Map as Map
import qualified Data.IntSet as Set
import Text.Read (readMaybe)

-- | Parse a string into 'BCG.BCG'
-- Each line of the string represents an edge. Each line is made up of 6 elements in a specific order separated by spaces.
-- The elements are
-- 
-- 1. vertex_id_0
-- 2. colour_id_0
-- 3. vertex_id_1
-- 4. colour_id_1
-- 5. weight_real_part
-- 6. weight_imaginary_part
-- 
-- __Example__
--
-- @
-- 1 green 2 green 1 0
-- 1 blue  3 blue  1 0
-- 1 red   4 green 0 1
-- 1 red   6 red   1 0
-- 2 red   3 red   1 0
-- 2 blue  5 blue  1 0
-- 3 green 4 green 1 0
-- 3 green 6 red   0 1
-- 4 red   5 red   1 0
-- 4 red   6 green 0 1
-- 4 blue  6 blue  1 0
-- 5 green 6 green 1 0
-- @
--
-- ![example bi-colored graph](../assets/ExampleGraph.png)
parse :: String -> Either (ParseException, Int) BCG
parse :: String -> Either (ParseException, Int) BCG
parse String
s = case [Either ParseException BCEToken]
-> Either (ParseException, Int) [BCEToken]
parsePossibleBCETokens ([Either ParseException BCEToken]
 -> Either (ParseException, Int) [BCEToken])
-> [Either ParseException BCEToken]
-> Either (ParseException, Int) [BCEToken]
forall a b. (a -> b) -> a -> b
$ ([String] -> Either ParseException BCEToken)
-> [[String]] -> [Either ParseException BCEToken]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Either ParseException BCEToken
parseLine ([[String]] -> [Either ParseException BCEToken])
-> [[String]] -> [Either ParseException BCEToken]
forall a b. (a -> b) -> a -> b
$ ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s of
  Right [BCEToken]
tokens -> BCG -> Either (ParseException, Int) BCG
forall a b. b -> Either a b
Right (BCG -> Either (ParseException, Int) BCG)
-> BCG -> Either (ParseException, Int) BCG
forall a b. (a -> b) -> a -> b
$ Persistent -> [BCEToken] -> BCG
parseBCETokens (NameIdMap -> NameIdMap -> Persistent
P NameIdMap
forall k a. Map k a
Map.empty NameIdMap
forall k a. Map k a
Map.empty) [BCEToken]
tokens
  Left (ParseException, Int)
e -> (ParseException, Int) -> Either (ParseException, Int) BCG
forall a b. a -> Either a b
Left (ParseException, Int)
e

-- | Exceptions returned by the parser
data ParseException
  = IncorrectNumberOfParameters -- ^ The line has an incorrect number of parameters
  | ComplexNumberParseFailure   -- ^ The real or imaginary part of the complex number couldn't be parsed into 'Prelude.Double'
  deriving (Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show)

-- Internal from this point on

-- Map of names and corresponding 'Int' IDs
type NameIdMap = (Map.Map String Int)

-- | Data to be stored throughout the parsing process
data Persistent
  = P
  NameIdMap -- ^ Map of Vertex names to their Int IDs
  NameIdMap -- ^ Map of Color names to their Int IDs

-- | Similar to 'BCG.BCE' but uses names instead of IDs
data BCEToken = BCEToken { BCEToken -> String
fromV :: String         -- ^ From Vertex
                         , BCEToken -> String
fromC :: String         -- ^ From Colour
                         , BCEToken -> String
toV   :: String         -- ^ To Vertex
                         , BCEToken -> String
toC   :: String         -- ^ To Colour
                         , BCEToken -> Complex Double
w     :: Complex Double -- ^ Weight
} deriving Int -> BCEToken -> ShowS
[BCEToken] -> ShowS
BCEToken -> String
(Int -> BCEToken -> ShowS)
-> (BCEToken -> String) -> ([BCEToken] -> ShowS) -> Show BCEToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BCEToken] -> ShowS
$cshowList :: [BCEToken] -> ShowS
show :: BCEToken -> String
$cshow :: BCEToken -> String
showsPrec :: Int -> BCEToken -> ShowS
$cshowsPrec :: Int -> BCEToken -> ShowS
Show

-- | Parse a line into a 'BCEToken'
parseLine :: [String] -> Either ParseException BCEToken
parseLine :: [String] -> Either ParseException BCEToken
parseLine [String
fv, String
fc, String
tv, String
tc, String
rw, String
iw] = case String -> String -> Maybe (Complex Double)
parseComplexNumber String
rw String
iw of
  Just Complex Double
w -> BCEToken -> Either ParseException BCEToken
forall a b. b -> Either a b
Right (BCEToken -> Either ParseException BCEToken)
-> BCEToken -> Either ParseException BCEToken
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> Complex Double -> BCEToken
BCEToken String
fv String
fc String
tv String
tc Complex Double
w
  Maybe (Complex Double)
Nothing  -> ParseException -> Either ParseException BCEToken
forall a b. a -> Either a b
Left ParseException
ComplexNumberParseFailure
parseLine [String]
_ = ParseException -> Either ParseException BCEToken
forall a b. a -> Either a b
Left ParseException
IncorrectNumberOfParameters

-- | Parse possible 'BCEToken's into 'BCEToken's or return an exception
parsePossibleBCETokens :: [Either ParseException BCEToken] -> Either (ParseException, Int) [BCEToken]
parsePossibleBCETokens :: [Either ParseException BCEToken]
-> Either (ParseException, Int) [BCEToken]
parsePossibleBCETokens (Either ParseException BCEToken
ept:[Either ParseException BCEToken]
pts) = case Either ParseException BCEToken
ept of
  Right BCEToken
t -> case [Either ParseException BCEToken]
-> Either (ParseException, Int) [BCEToken]
parsePossibleBCETokens [Either ParseException BCEToken]
pts of
    Right [BCEToken]
ts            -> [BCEToken] -> Either (ParseException, Int) [BCEToken]
forall a b. b -> Either a b
Right ([BCEToken] -> Either (ParseException, Int) [BCEToken])
-> [BCEToken] -> Either (ParseException, Int) [BCEToken]
forall a b. (a -> b) -> a -> b
$ BCEToken
tBCEToken -> [BCEToken] -> [BCEToken]
forall a. a -> [a] -> [a]
:[BCEToken]
ts
    Left (ParseException
e, Int
l)         -> (ParseException, Int) -> Either (ParseException, Int) [BCEToken]
forall a b. a -> Either a b
Left (ParseException
e, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Left ParseException
e                -> (ParseException, Int) -> Either (ParseException, Int) [BCEToken]
forall a b. a -> Either a b
Left (ParseException
e, Int
1)
parsePossibleBCETokens [Either ParseException BCEToken]
_ = [BCEToken] -> Either (ParseException, Int) [BCEToken]
forall a b. b -> Either a b
Right []

-- | Parse 'BCETokens' into a 'BCG'
parseBCETokens :: Persistent -> [BCEToken] -> BCG
parseBCETokens :: Persistent -> [BCEToken] -> BCG
parseBCETokens (P NameIdMap
v NameIdMap
c) ((BCEToken String
fv String
fc String
tv String
tc Complex Double
w):[BCEToken]
ts) = case Persistent -> [BCEToken] -> BCG
parseBCETokens (NameIdMap -> NameIdMap -> Persistent
P NameIdMap
nnv NameIdMap
nnc) [BCEToken]
ts of
  BCG [BCE]
bces IntSet
vertices Int
colors -> [BCE] -> IntSet -> Int -> BCG
BCG (Int -> Int -> Int -> Int -> Complex Double -> BCE
BCE Int
fvId Int
fcId Int
tvId Int
tcId Complex Double
wBCE -> [BCE] -> [BCE]
forall a. a -> [a] -> [a]
:[BCE]
bces) IntSet
vertices Int
colors
  where
    ((NameIdMap
nv, Int
fvId), (NameIdMap
nc, Int
fcId)) = (NameIdMap -> String -> (NameIdMap, Int)
getId NameIdMap
v String
fv, NameIdMap -> String -> (NameIdMap, Int)
getId NameIdMap
c String
fc)
    ((NameIdMap
nnv, Int
tvId), (NameIdMap
nnc, Int
tcId)) = (NameIdMap -> String -> (NameIdMap, Int)
getId NameIdMap
nv String
tv, NameIdMap -> String -> (NameIdMap, Int)
getId NameIdMap
nc String
tc)
parseBCETokens (P NameIdMap
v NameIdMap
c) [BCEToken]
_ = [BCE] -> IntSet -> Int -> BCG
BCG [] ([Int] -> IntSet
Set.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd ([(String, Int)] -> [Int]) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ NameIdMap -> [(String, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList NameIdMap
v) (Int -> BCG) -> Int -> BCG
forall a b. (a -> b) -> a -> b
$ NameIdMap -> Int
forall k a. Map k a -> Int
Map.size NameIdMap
c

-- | Parse two strings into real number parts of a complex number
parseComplexNumber :: String -> String -> Maybe (Complex Double)
parseComplexNumber :: String -> String -> Maybe (Complex Double)
parseComplexNumber String
sr String
si = case (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
sr :: Maybe Double, String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
si :: Maybe Double) of
  (Just Double
r, Just Double
i) -> Complex Double -> Maybe (Complex Double)
forall a. a -> Maybe a
Just (Complex Double -> Maybe (Complex Double))
-> Complex Double -> Maybe (Complex Double)
forall a b. (a -> b) -> a -> b
$ Double
r Double -> Double -> Complex Double
forall a. a -> a -> Complex a
:+ Double
i
  (Maybe Double, Maybe Double)
_ -> Maybe (Complex Double)
forall a. Maybe a
Nothing

-- | Gets the corresponding ID for a name and adds a new one if one does not exist
getId :: NameIdMap -> String -> (NameIdMap, Int)
getId :: NameIdMap -> String -> (NameIdMap, Int)
getId NameIdMap
m String
k = case String -> NameIdMap -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
k NameIdMap
m of
  Just Int
id -> (NameIdMap
m, Int
id)
  Maybe Int
Nothing -> (String -> Int -> NameIdMap -> NameIdMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k Int
newId NameIdMap
m, Int
newId)
  where newId :: Int
newId = NameIdMap -> Int
forall k a. Map k a -> Int
Map.size NameIdMap
m