{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoFieldSelectors #-} module TypedSession.State.Render (runRender) where import Control.Algebra ((:+:)) import Control.Carrier.Reader (runReader) import Control.Carrier.State.Strict (runState) import Control.Carrier.Writer.Strict (runWriter) import Control.Effect.Reader import Control.Effect.State import Control.Effect.Writer import Control.Monad (when) import Data.Foldable (for_) import qualified Data.List as L import Data.Semigroup (Max (..)) import Data.Traversable (for) import TypedSession.State.Type import TypedSession.State.Utils data RenderProt type instance XMsg RenderProt = (String, [String]) type instance XLabel RenderProt = (String, [String]) type instance XBranch RenderProt = (String, [String]) type instance XBranchSt RenderProt = String type instance XGoto RenderProt = (String, [String]) type instance XTerminal RenderProt = (String, [String]) parensWarapper :: String -> String parensWarapper :: String -> String parensWarapper String st = String "(" String -> String -> String forall a. Semigroup a => a -> a -> a <> String st String -> String -> String forall a. Semigroup a => a -> a -> a <> String ")" newtype LV = LV Int deriving (Int -> LV -> String -> String [LV] -> String -> String LV -> String (Int -> LV -> String -> String) -> (LV -> String) -> ([LV] -> String -> String) -> Show LV forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a $cshowsPrec :: Int -> LV -> String -> String showsPrec :: Int -> LV -> String -> String $cshow :: LV -> String show :: LV -> String $cshowList :: [LV] -> String -> String showList :: [LV] -> String -> String Show, LV -> LV -> Bool (LV -> LV -> Bool) -> (LV -> LV -> Bool) -> Eq LV forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LV -> LV -> Bool == :: LV -> LV -> Bool $c/= :: LV -> LV -> Bool /= :: LV -> LV -> Bool Eq, Eq LV Eq LV => (LV -> LV -> Ordering) -> (LV -> LV -> Bool) -> (LV -> LV -> Bool) -> (LV -> LV -> Bool) -> (LV -> LV -> Bool) -> (LV -> LV -> LV) -> (LV -> LV -> LV) -> Ord LV LV -> LV -> Bool LV -> LV -> Ordering LV -> LV -> LV forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: LV -> LV -> Ordering compare :: LV -> LV -> Ordering $c< :: LV -> LV -> Bool < :: LV -> LV -> Bool $c<= :: LV -> LV -> Bool <= :: LV -> LV -> Bool $c> :: LV -> LV -> Bool > :: LV -> LV -> Bool $c>= :: LV -> LV -> Bool >= :: LV -> LV -> Bool $cmax :: LV -> LV -> LV max :: LV -> LV -> LV $cmin :: LV -> LV -> LV min :: LV -> LV -> LV Ord, Integer -> LV LV -> LV LV -> LV -> LV (LV -> LV -> LV) -> (LV -> LV -> LV) -> (LV -> LV -> LV) -> (LV -> LV) -> (LV -> LV) -> (LV -> LV) -> (Integer -> LV) -> Num LV forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a $c+ :: LV -> LV -> LV + :: LV -> LV -> LV $c- :: LV -> LV -> LV - :: LV -> LV -> LV $c* :: LV -> LV -> LV * :: LV -> LV -> LV $cnegate :: LV -> LV negate :: LV -> LV $cabs :: LV -> LV abs :: LV -> LV $csignum :: LV -> LV signum :: LV -> LV $cfromInteger :: Integer -> LV fromInteger :: Integer -> LV Num, LV LV -> LV -> Bounded LV forall a. a -> a -> Bounded a $cminBound :: LV minBound :: LV $cmaxBound :: LV maxBound :: LV Bounded) newtype RV = RV Int deriving (Int -> RV -> String -> String [RV] -> String -> String RV -> String (Int -> RV -> String -> String) -> (RV -> String) -> ([RV] -> String -> String) -> Show RV forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a $cshowsPrec :: Int -> RV -> String -> String showsPrec :: Int -> RV -> String -> String $cshow :: RV -> String show :: RV -> String $cshowList :: [RV] -> String -> String showList :: [RV] -> String -> String Show, RV -> RV -> Bool (RV -> RV -> Bool) -> (RV -> RV -> Bool) -> Eq RV forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: RV -> RV -> Bool == :: RV -> RV -> Bool $c/= :: RV -> RV -> Bool /= :: RV -> RV -> Bool Eq, Eq RV Eq RV => (RV -> RV -> Ordering) -> (RV -> RV -> Bool) -> (RV -> RV -> Bool) -> (RV -> RV -> Bool) -> (RV -> RV -> Bool) -> (RV -> RV -> RV) -> (RV -> RV -> RV) -> Ord RV RV -> RV -> Bool RV -> RV -> Ordering RV -> RV -> RV forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: RV -> RV -> Ordering compare :: RV -> RV -> Ordering $c< :: RV -> RV -> Bool < :: RV -> RV -> Bool $c<= :: RV -> RV -> Bool <= :: RV -> RV -> Bool $c> :: RV -> RV -> Bool > :: RV -> RV -> Bool $c>= :: RV -> RV -> Bool >= :: RV -> RV -> Bool $cmax :: RV -> RV -> RV max :: RV -> RV -> RV $cmin :: RV -> RV -> RV min :: RV -> RV -> RV Ord, Integer -> RV RV -> RV RV -> RV -> RV (RV -> RV -> RV) -> (RV -> RV -> RV) -> (RV -> RV -> RV) -> (RV -> RV) -> (RV -> RV) -> (RV -> RV) -> (Integer -> RV) -> Num RV forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a $c+ :: RV -> RV -> RV + :: RV -> RV -> RV $c- :: RV -> RV -> RV - :: RV -> RV -> RV $c* :: RV -> RV -> RV * :: RV -> RV -> RV $cnegate :: RV -> RV negate :: RV -> RV $cabs :: RV -> RV abs :: RV -> RV $csignum :: RV -> RV signum :: RV -> RV $cfromInteger :: Integer -> RV fromInteger :: Integer -> RV Num, RV RV -> RV -> Bounded RV forall a. a -> a -> Bounded a $cminBound :: RV minBound :: RV $cmaxBound :: RV maxBound :: RV Bounded) mkLeftStr :: (Has (State Int :+: Writer (Max LV)) sig m) => String -> m String mkLeftStr :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr String str = do indent <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State s) sig m => m s get @Int let str' = Int -> Char -> String forall a. Int -> a -> [a] replicate (Int indent Int -> Int -> Int forall a. Num a => a -> a -> a * Int 2 Int -> Int -> Int forall a. Num a => a -> a -> a + Int 2) Char ' ' String -> String -> String forall a. Semigroup a => a -> a -> a <> String str tell (Max $ LV $ length str') pure str' render1XTraverse :: forall r bst sig m . ( Has (State Int :+: Writer (Max LV) :+: Writer (Max RV)) sig m , Show bst , Enum r , Bounded r , Eq r , Ord r , Show r ) => XTraverse m (MsgT r bst) RenderProt r bst render1XTraverse :: forall r bst (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (State Int :+: (Writer (Max LV) :+: Writer (Max RV))) sig m, Show bst, Enum r, Bounded r, Eq r, Ord r, Show r) => XTraverse m (MsgT r bst) RenderProt r bst render1XTraverse = ( \(([T bst] ts, (r from, r to), Int idx), (String constr, [[String]] args, r _, r _, Protocol (MsgT r bst) r bst _)) -> do Bool -> m () -> m () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Int idx Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 0) (forall s (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State s) sig m => (s -> s) -> m () modify @Int (Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1)) nst <- String -> m String forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr (String constr String -> String -> String forall a. Semigroup a => a -> a -> a <> String " [" String -> String -> String forall a. Semigroup a => a -> a -> a <> String -> [String] -> String forall a. [a] -> [[a]] -> [a] L.intercalate String "," (([String] -> String) -> [[String]] -> [String] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (String -> [String] -> String forall a. [a] -> [[a]] -> [a] L.intercalate String " ") [[String]] args) String -> String -> String forall a. Semigroup a => a -> a -> a <> String "]") ts' <- for (zip (rRange @r) ts) $ \(r r, T bst t) -> do let sht :: String sht = String -> String parensWarapper (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ T bst -> String forall a. Show a => a -> String show T bst t sht' :: String sht' = if | r r r -> r -> Bool forall a. Eq a => a -> a -> Bool == r from -> String "Send " String -> String -> String forall a. Semigroup a => a -> a -> a <> String sht | r r r -> r -> Bool forall a. Eq a => a -> a -> Bool == r to -> String "Recv " String -> String -> String forall a. Semigroup a => a -> a -> a <> String sht | Bool otherwise -> String " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String sht Max RV -> m () forall w (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (Writer w) sig m => w -> m () tell (Max RV -> m ()) -> Max RV -> m () forall a b. (a -> b) -> a -> b $ RV -> Max RV forall a. a -> Max a Max (RV -> Max RV) -> RV -> Max RV forall a b. (a -> b) -> a -> b $ Int -> RV RV (String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String sht') String -> m String forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure String sht' pure (nst, ts') , \(([T bst] ts, Int i), (Int, Protocol (MsgT r bst) r bst) _) -> (String, [String]) -> m (String, [String]) forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (String "Label " String -> String -> String forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int i, [T bst] -> [String] forall bst. Show bst => [T bst] -> [String] mkStrs [T bst] ts) , \(XBranch (MsgT r bst) ts, (r r, String st, [BranchSt (MsgT r bst) r bst] _)) -> do nst <- String -> m String forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr (String -> m String) -> String -> m String forall a b. (a -> b) -> a -> b $ String "[Branch " String -> String -> String forall a. Semigroup a => a -> a -> a <> r -> String forall a. Show a => a -> String show r r String -> String -> String forall a. Semigroup a => a -> a -> a <> String " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String st String -> String -> String forall a. Semigroup a => a -> a -> a <> String "]" pure ((nst, mkStrs ts), restoreWrapper @Int) , \(XBranchSt (MsgT r bst) _, (bst bst, [[String]] args, Protocol (MsgT r bst) r bst _)) -> do nst <- String -> m String forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr (String -> m String) -> String -> m String forall a b. (a -> b) -> a -> b $ String "* BranchSt_" String -> String -> String forall a. Semigroup a => a -> a -> a <> bst -> String forall a. Show a => a -> String show bst bst String -> String -> String forall a. Semigroup a => a -> a -> a <> String " [" String -> String -> String forall a. Semigroup a => a -> a -> a <> String -> [String] -> String forall a. [a] -> [[a]] -> [a] L.intercalate String "," (([String] -> String) -> [[String]] -> [String] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (String -> [String] -> String forall a. [a] -> [[a]] -> [a] L.intercalate String " ") [[String]] args) String -> String -> String forall a. Semigroup a => a -> a -> a <> String "]" pure nst , \(([T bst] ts, Int i), Int _) -> do nst <- String -> m String forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr (String -> m String) -> String -> m String forall a b. (a -> b) -> a -> b $ String "Goto " String -> String -> String forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int i pure (nst, mkStrs ts) , \XTerminal (MsgT r bst) ts -> do nst <- String -> m String forall (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (State Int :+: Writer (Max LV)) sig m => String -> m String mkLeftStr String "Terminal" pure (nst, mkStrs ts) ) mkStrs :: (Show bst) => [T bst] -> [String] mkStrs :: forall bst. Show bst => [T bst] -> [String] mkStrs [T bst] ts = (T bst -> String) -> [T bst] -> [String] forall a b. (a -> b) -> [a] -> [b] map ((String " " String -> String -> String forall a. Semigroup a => a -> a -> a <>) (String -> String) -> (T bst -> String) -> T bst -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String parensWarapper (String -> String) -> (T bst -> String) -> T bst -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . T bst -> String forall a. Show a => a -> String show) [T bst] ts fillStr :: Char -> Int -> String -> String fillStr :: Char -> Int -> String -> String fillStr Char c Int i String st = let len :: Int len = String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String st in case Int -> Int -> Ordering forall a. Ord a => a -> a -> Ordering compare Int len Int i of Ordering EQ -> String st Ordering LT -> String st String -> String -> String forall a. Semigroup a => a -> a -> a <> Int -> Char -> String forall a. Int -> a -> [a] replicate (Int i Int -> Int -> Int forall a. Num a => a -> a -> a - Int len) Char c Ordering GT -> String st mkLine :: forall r sig m . ( Has (Reader (LV, RV) :+: Writer [String]) sig m , Enum r , Bounded r ) => (String, [String]) -> m () mkLine :: forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine (String ls, [String] rs) = do (LV maxLv, RV maxRv) <- m (LV, RV) forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (Reader r) sig m => m r ask let leftMaxPos = Int maxLv Int -> Int -> Int forall a. Num a => a -> a -> a + Int 3 rightMaxPos = Int maxRv Int -> Int -> Int forall a. Num a => a -> a -> a + Int 2 tell [fillStr ' ' leftMaxPos ls <> concatMap (fillStr ' ' rightMaxPos) rs] render2XFold :: forall r bst sig m . ( Has (Reader (LV, RV) :+: Writer [String]) sig m , Enum r , Bounded r ) => XFold m RenderProt r bst render2XFold :: forall r bst (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => XFold m RenderProt r bst render2XFold = ( \(XMsg RenderProt vs, (String, [[String]], r, r, Protocol RenderProt r bst) _) -> forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String, [String]) XMsg RenderProt vs , \(XLabel RenderProt vs, Int _) -> forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String, [String]) XLabel RenderProt vs , \(XBranch RenderProt vs, (r, String, [BranchSt RenderProt r bst]) _) -> do forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String, [String]) XBranch RenderProt vs (m () -> m ()) -> m (m () -> m ()) forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure m () -> m () forall a. a -> a id , \(XBranchSt RenderProt ls, (bst, [[String]], Protocol RenderProt r bst) _) -> forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String XBranchSt RenderProt ls, []) , \(XGoto RenderProt vs, Int _) -> forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String, [String]) XGoto RenderProt vs , \XTerminal RenderProt vs -> forall r (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => (String, [String]) -> m () mkLine @r (String, [String]) XTerminal RenderProt vs ) runRender1 :: forall r bst . (Enum r, Bounded r, Ord r, Show bst, Show r) => Protocol (MsgT r bst) r bst -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) runRender1 :: forall r bst. (Enum r, Bounded r, Ord r, Show bst, Show r) => Protocol (MsgT r bst) r bst -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) runRender1 Protocol (MsgT r bst) r bst prot = Identity (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) forall a. Identity a -> a run (Identity (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst)))) -> (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> Identity (Max LV, (Max RV, (Int, Protocol RenderProt r bst)))) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall w (m :: * -> *) a. Monoid w => WriterC w m a -> m (w, a) runWriter @(Max LV) (WriterC (Max LV) Identity (Max RV, (Int, Protocol RenderProt r bst)) -> Identity (Max LV, (Max RV, (Int, Protocol RenderProt r bst)))) -> (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> WriterC (Max LV) Identity (Max RV, (Int, Protocol RenderProt r bst))) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> Identity (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall w (m :: * -> *) a. Monoid w => WriterC w m a -> m (w, a) runWriter @(Max RV) (WriterC (Max RV) (WriterC (Max LV) Identity) (Int, Protocol RenderProt r bst) -> WriterC (Max LV) Identity (Max RV, (Int, Protocol RenderProt r bst))) -> (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> WriterC (Max RV) (WriterC (Max LV) Identity) (Int, Protocol RenderProt r bst)) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> WriterC (Max LV) Identity (Max RV, (Int, Protocol RenderProt r bst)) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a) runState @Int Int 0 (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst)))) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) forall a b. (a -> b) -> a -> b $ do let rg :: [r] rg = forall r. (Enum r, Bounded r) => [r] rRange @r [r] -> (r -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) ()) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) () forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ [r] rg ((r -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) ()) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) ()) -> (r -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) ()) -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) () forall a b. (a -> b) -> a -> b $ \r r -> Max RV -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) () forall w (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (Writer w) sig m => w -> m () tell (RV -> Max RV forall a. a -> Max a Max (Int -> RV RV (String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length (r -> String forall a. Show a => a -> String show r r)))) XTraverse (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity))) (MsgT r bst) RenderProt r bst -> Protocol (MsgT r bst) r bst -> StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity)) (Protocol RenderProt r bst) forall (m :: * -> *) eta gama r bst. Monad m => XTraverse m eta gama r bst -> Protocol eta r bst -> m (Protocol gama r bst) xtraverse XTraverse (StateC Int (WriterC (Max RV) (WriterC (Max LV) Identity))) (MsgT r bst) RenderProt r bst forall r bst (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (State Int :+: (Writer (Max LV) :+: Writer (Max RV))) sig m, Show bst, Enum r, Bounded r, Eq r, Ord r, Show r) => XTraverse m (MsgT r bst) RenderProt r bst render1XTraverse Protocol (MsgT r bst) r bst prot runRender :: forall r bst. (Enum r, Bounded r, Ord r, Show bst, Show r) => Protocol (MsgT r bst) r bst -> String runRender :: forall r bst. (Enum r, Bounded r, Ord r, Show bst, Show r) => Protocol (MsgT r bst) r bst -> String runRender Protocol (MsgT r bst) r bst prot = let (Max lv :: LV lv@(LV Int maxLv), (Max rv :: RV rv@(RV Int maxRv), (Int _, Protocol RenderProt r bst prot1))) = Protocol (MsgT r bst) r bst -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) forall r bst. (Enum r, Bounded r, Ord r, Show bst, Show r) => Protocol (MsgT r bst) r bst -> (Max LV, (Max RV, (Int, Protocol RenderProt r bst))) runRender1 Protocol (MsgT r bst) r bst prot header :: String header = Int -> Char -> String forall a. Int -> a -> [a] replicate (Int maxLv Int -> Int -> Int forall a. Num a => a -> a -> a + Int 3) Char '-' String -> String -> String forall a. Semigroup a => a -> a -> a <> (String -> String) -> [String] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (Char -> Int -> String -> String fillStr Char '-' (Int maxRv Int -> Int -> Int forall a. Num a => a -> a -> a + Int 2)) [r -> String forall a. Show a => a -> String show r r | r r <- forall r. (Enum r, Bounded r) => [r] rRange @r] in [String] -> String unlines ([String] -> String) -> (WriterC [String] (ReaderC (LV, RV) Identity) () -> [String]) -> WriterC [String] (ReaderC (LV, RV) Identity) () -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . ([String], ()) -> [String] forall a b. (a, b) -> a fst (([String], ()) -> [String]) -> (WriterC [String] (ReaderC (LV, RV) Identity) () -> ([String], ())) -> WriterC [String] (ReaderC (LV, RV) Identity) () -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . Identity ([String], ()) -> ([String], ()) forall a. Identity a -> a run (Identity ([String], ()) -> ([String], ())) -> (WriterC [String] (ReaderC (LV, RV) Identity) () -> Identity ([String], ())) -> WriterC [String] (ReaderC (LV, RV) Identity) () -> ([String], ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . (LV, RV) -> ReaderC (LV, RV) Identity ([String], ()) -> Identity ([String], ()) forall r (m :: * -> *) a. r -> ReaderC r m a -> m a runReader (LV lv, RV rv) (ReaderC (LV, RV) Identity ([String], ()) -> Identity ([String], ())) -> (WriterC [String] (ReaderC (LV, RV) Identity) () -> ReaderC (LV, RV) Identity ([String], ())) -> WriterC [String] (ReaderC (LV, RV) Identity) () -> Identity ([String], ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall w (m :: * -> *) a. Monoid w => WriterC w m a -> m (w, a) runWriter @[String] (WriterC [String] (ReaderC (LV, RV) Identity) () -> String) -> WriterC [String] (ReaderC (LV, RV) Identity) () -> String forall a b. (a -> b) -> a -> b $ do [String] -> WriterC [String] (ReaderC (LV, RV) Identity) () forall w (sig :: (* -> *) -> * -> *) (m :: * -> *). Has (Writer w) sig m => w -> m () tell [String header] XFold (WriterC [String] (ReaderC (LV, RV) Identity)) RenderProt r bst -> Protocol RenderProt r bst -> WriterC [String] (ReaderC (LV, RV) Identity) () forall (m :: * -> *) eta r bst. Monad m => XFold m eta r bst -> Protocol eta r bst -> m () xfold XFold (WriterC [String] (ReaderC (LV, RV) Identity)) RenderProt r bst forall r bst (sig :: (* -> *) -> * -> *) (m :: * -> *). (Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r, Bounded r) => XFold m RenderProt r bst render2XFold Protocol RenderProt r bst prot1