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 :: 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
data ParseException
= IncorrectNumberOfParameters
| ComplexNumberParseFailure
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)
type NameIdMap = (Map.Map String Int)
data Persistent
= P
NameIdMap
NameIdMap
data BCEToken = BCEToken { BCEToken -> String
fromV :: String
, BCEToken -> String
fromC :: String
, BCEToken -> String
toV :: String
, BCEToken -> String
toC :: String
, BCEToken -> Complex Double
w :: Complex Double
} 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
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
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 []
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
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
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