{-# 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 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
      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
        indent <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Int
        let sht =
              if
                | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& r
r r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
from -> 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 -> 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)
                | Bool
otherwise -> T bst -> String
forall a. Show a => a -> String
show T bst
t
            sht' =
              if
                | r
r r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
from -> String
sht String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ->"
                | r
r r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
to -> String
sht String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" <-"
                | Bool
otherwise -> String
sht
        tell $ Max $ RV (length sht')
        pure sht'
      when (idx == 0) (modify @Int (+ 1))
      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) -> [T bst] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map T bst -> String
forall a. Show a => a -> String
show [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
"]"
      indent <- get @Int
      let ts' =
            [ if r
r1 r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
r then 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
<> T bst -> String
forall a. Show a => a -> String
show T bst
t else T bst -> String
forall a. Show a => a -> String
show T bst
t
            | (r
r1, T bst
t) <- [r] -> [T bst] -> [(r, T bst)]
forall a b. [a] -> [b] -> [(a, b)]
zip (forall r. (Enum r, Bounded r) => [r]
rRange @r) [T bst]
XBranch (MsgT r bst)
ts
            ]
      pure ((nst, 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, map show 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, map show 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 -> String
forall a. HasCallStack => String -> a
error String
"np"

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
  :: (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
$ 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