{-# 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 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.Semigroup (Max (..))
import Data.Traversable (for)
import TypedSession.State.Type
import TypedSession.State.Utils
import qualified Data.List as L

data RenderProt

type instance XMsg RenderProt = (String, [String])
type instance XLabel RenderProt = (String, [String])
type instance XBranch RenderProt = (String, [String])
type instance XBranchSt RenderProt = ()
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
3) 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]
args String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]")
      when (idx == 0) (modify @Int (+ 1))
      ts' <- for (zip (rRange @r) ts) $ \(r
r, T bst
t) -> do
        let sht :: String
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 -> 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' :: String
sht' =
              if
                | r
r r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
from ->
                    if
                      | r
from r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
to -> String
"<- " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sht
                      | Bool
otherwise -> 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 ->
                    if
                      | r
from r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
to -> String
sht String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" <-"
                      | Bool
otherwise -> String
"-> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sht
                | Bool
otherwise -> 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) -> [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, [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
"]"
      pure ((nst, map show ts), restoreWrapper @Int)
  , \(XBranchSt (MsgT r bst), (bst, Protocol (MsgT r bst) r bst))
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , \(([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]

render2XTraverse
  :: forall r bst sig m
   . ( Has (Reader (LV, RV) :+: Writer [String]) sig m
     , Enum r
     , Bounded r
     )
  => XFold m RenderProt r bst
render2XTraverse :: forall r bst (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Reader (LV, RV) :+: Writer [String]) sig m, Enum r,
 Bounded r) =>
XFold m RenderProt r bst
render2XTraverse =
  ( \(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, [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, (bst, Protocol RenderProt r bst))
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , \(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
render2XTraverse Protocol RenderProt r bst
prot1