{-# LANGUAGE DeriveGeneric #-}
module Math.ExpPairs.Process
( Process ()
, Path (Path)
, aPath
, baPath
, evalPath
, lengthPath
) where
import GHC.Generics (Generic)
import Data.Text.Prettyprint.Doc hiding ((<>))
import Math.ExpPairs.ProcessMatrix
import Math.ExpPairs.PrettyProcess
data Path = Path !ProcessMatrix ![Process]
deriving (Eq, Show, Generic)
instance Semigroup Path where
Path m1 p1 <> Path m2 p2 = Path (m1 <> m2) (p1 <> p2)
instance Monoid Path where
mempty = Path mempty mempty
mappend = (<>)
instance Pretty Path where
pretty (Path _ l) = pretty (prettify l)
instance Read Path where
readsPrec _ zs = [reads' zs] where
reads' ('A':xs) = (aPath <> path, ys) where
(path, ys) = reads' xs
reads' ('B':'A':xs) = (baPath <> path, ys) where
(path, ys) = reads' xs
reads' ('B':xs) = (baPath, xs)
reads' xs = (mempty, xs)
instance Ord Path where
compare (Path _ x) (Path _ y) = cmp x y where
cmp [] [] = EQ
cmp ( A:u) ( A:v) = cmp u v
cmp (BA:u) (BA:v) = cmp v u
cmp ( A:_) _ = LT
cmp (BA:_) _ = GT
cmp _ ( A:_) = GT
cmp _ (BA:_) = LT
aPath :: Path
aPath = Path aMatrix [ A]
baPath :: Path
baPath = Path baMatrix [BA]
evalPath :: (Num t) => Path -> (t, t, t) -> (t, t, t)
evalPath (Path m _) = evalMatrix m
lengthPath :: Path -> Int
lengthPath (Path _ xs) = length xs