{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}

module PrettyPrint where

import Control.Comonad.Cofree
import qualified Control.Comonad.Trans.Cofree as CofreeT (CofreeF (..))
import Control.Monad.State (State)
import qualified Control.Monad.State as State
import Data.Functor.Foldable
import Data.List (elemIndex)
import Data.Map (Map)
import qualified Data.Map as Map
import Naturals (NExpr (..), NExprs (..), NResult)
import Telomare
import Text.Read (readMaybe)
-- import Data.SBV (sFPHalf)


class PrettyPrintable p where
  showP :: p -> State Int String

class PrettyPrintable1 p where
  showP1 :: PrettyPrintable a => p a -> State Int String

instance (PrettyPrintable1 f, PrettyPrintable x) => PrettyPrintable (f x) where
  showP :: f x -> State Int String
showP = forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1

-- instance (Base r ~ PrettyPrintable1 f, Recursive r) => PrettyPrintable r where

prettyPrint :: PrettyPrintable p => p -> String
prettyPrint :: forall p. PrettyPrintable p => p -> String
prettyPrint p
x = forall s a. State s a -> s -> a
State.evalState (forall p. PrettyPrintable p => p -> State Int String
showP p
x) Int
0

indentation :: Int -> String
indentation :: Int -> String
indentation Int
0 = []
indentation Int
n = Char
' ' forall a. a -> [a] -> [a]
: Char
' ' forall a. a -> [a] -> [a]
: Int -> String
indentation (Int
n forall a. Num a => a -> a -> a
- Int
1)

showPIExpr :: Int -> Int -> IExpr -> String
showPIExpr :: Int -> Int -> IExpr -> String
showPIExpr Int
_ Int
_ IExpr
Zero = String
"Z"
showPIExpr Int
_ Int
_ IExpr
Env = String
"E"
showPIExpr Int
l Int
i (Pair IExpr
a IExpr
b) =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"P\n", Int -> String
indentation Int
i, Int -> Int -> IExpr -> String
showPIExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) IExpr
a, String
"\n", Int -> String
indentation Int
i, Int -> Int -> IExpr -> String
showPIExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) IExpr
b]
showPIExpr Int
l Int
i (Gate IExpr
a IExpr
b) = -- "G"
  String
"G\n" forall a. Semigroup a => a -> a -> a
<> Int -> String
indentation Int
i forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) IExpr
a forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> String
indentation Int
i forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) IExpr
b
showPIExpr Int
_ Int
_ IExpr
Trace = String
"T"
showPIExpr Int
l Int
i (Defer IExpr
x) = String
"D " forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l Int
i IExpr
x
showPIExpr Int
l Int
i (PLeft IExpr
x) = String
"L " forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l Int
i IExpr
x
showPIExpr Int
l Int
i (PRight IExpr
x) = String
"R " forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l Int
i IExpr
x
showPIExpr Int
l Int
i (SetEnv IExpr
x) = String
"S " forall a. Semigroup a => a -> a -> a
<> Int -> Int -> IExpr -> String
showPIExpr Int
l Int
i IExpr
x

showPIE :: IExpr -> String
showPIE = Int -> Int -> IExpr -> String
showPIExpr Int
80 Int
1

showTPIExpr :: Map Int PartialType -> Int -> Int -> IExpr -> String
showTPIExpr :: Map Int PartialType -> Int -> Int -> IExpr -> String
showTPIExpr Map Int PartialType
typeMap Int
l Int
i IExpr
expr =
  let recur :: IExpr -> String
recur = Map Int PartialType -> Int -> Int -> IExpr -> String
showTPIExpr Map Int PartialType
typeMap Int
l Int
i
      indented :: IExpr -> String
indented IExpr
x = (Int -> String
indentation Int
i forall a. Semigroup a => a -> a -> a
<> Map Int PartialType -> Int -> Int -> IExpr -> String
showTPIExpr Map Int PartialType
typeMap Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) IExpr
x)
  in case IExpr
expr of
    IExpr
Zero       -> String
"Z"
    IExpr
Env        -> String
"E"
    (Pair IExpr
a IExpr
b) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"P\n", IExpr -> String
indented IExpr
a, String
"\n", IExpr -> String
indented IExpr
b]
    Gate IExpr
a IExpr
b   -> String
"G\n" forall a. Semigroup a => a -> a -> a
<> IExpr -> String
indented IExpr
a forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> IExpr -> String
indented IExpr
b
    IExpr
Trace      -> String
"T"

showNExpr :: Map FragIndex NResult -> Int -> Int -> NExpr -> String
showNExpr :: Map FragIndex NResult -> Int -> Int -> NResult -> String
showNExpr Map FragIndex NResult
nMap Int
l Int
i NResult
expr =
  let recur :: NResult -> String
recur = Map FragIndex NResult -> Int -> Int -> NResult -> String
showNExpr Map FragIndex NResult
nMap Int
l Int
i
      showTwo :: String -> NResult -> NResult -> String
showTwo String
c NResult
a NResult
b =
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
c, String
"\n", Int -> String
indentation Int
i, Map FragIndex NResult -> Int -> Int -> NResult -> String
showNExpr Map FragIndex NResult
nMap Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) NResult
a, String
"\n", Int -> String
indentation Int
i, Map FragIndex NResult -> Int -> Int -> NResult -> String
showNExpr Map FragIndex NResult
nMap Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) NResult
b]
  in case NResult
expr of
  NResult
NZero -> String
"Z"
  NResult
NEnv -> String
"E"
  (NPair NResult
a NResult
b) -> String -> NResult -> NResult -> String
showTwo String
"P" NResult
a NResult
b
  NGate NResult
a NResult
b -> String -> NResult -> NResult -> String
showTwo String
"G" NResult
a NResult
b
  NResult
NTrace -> String
"T"
  (NDefer FragIndex
ind) -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FragIndex
ind Map FragIndex NResult
nMap of
    (Just NResult
n) -> String
"D " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
n
    Maybe NResult
_        -> String
"NDefer error: no function found for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FragIndex
ind
  (NLeft NResult
x) -> String
"L " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
  (NRight NResult
x) -> String
"R " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
  (NSetEnv NResult
x) -> String
"S " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
  (NAdd NResult
a NResult
b) -> String -> NResult -> NResult -> String
showTwo String
"+" NResult
a NResult
b
  (NMult NResult
a NResult
b) -> String -> NResult -> NResult -> String
showTwo String
"X" NResult
a NResult
b
  (NPow NResult
a NResult
b) -> String -> NResult -> NResult -> String
showTwo String
"^" NResult
a NResult
b
  (NApp NResult
c NResult
i) -> String -> NResult -> NResult -> String
showTwo String
"$" NResult
c NResult
i
  (NNum Int64
n) -> forall a. Show a => a -> String
show Int64
n --concat ["()"]
  (NToChurch NResult
c NResult
i) -> String -> NResult -> NResult -> String
showTwo String
"<" NResult
c NResult
i
  (NOldDefer NResult
x) -> String
"% " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
  (NTwiddle NResult
x) -> String
"W " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x

showNIE :: NExprs -> String
showNIE (NExprs Map FragIndex NResult
m) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> FragIndex
FragIndex Int
0) Map FragIndex NResult
m of
  Just NResult
f -> Map FragIndex NResult -> Int -> Int -> NResult -> String
showNExpr Map FragIndex NResult
m Int
80 Int
1 NResult
f
  Maybe NResult
_      -> String
"error: no root nexpr"

showFragInds :: f FragIndex -> String
showFragInds f FragIndex
inds = let showInd :: FragIndex -> Int
showInd (FragIndex Int
i) = Int
i in forall a. Show a => a -> String
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FragIndex -> Int
showInd f FragIndex
inds)

showOneNExpr :: Int -> Int -> NExpr -> String
showOneNExpr :: Int -> Int -> NResult -> String
showOneNExpr Int
l Int
i NResult
expr =
  let recur :: NResult -> String
recur = Int -> Int -> NResult -> String
showOneNExpr Int
l Int
i
      showTwo :: String -> NResult -> NResult -> String
showTwo String
c NResult
a NResult
b =
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
c, String
"\n", Int -> String
indentation Int
i, Int -> Int -> NResult -> String
showOneNExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) NResult
a, String
"\n", Int -> String
indentation Int
i, Int -> Int -> NResult -> String
showOneNExpr Int
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) NResult
b]
  in case NResult
expr of
      NResult
NZero                    -> String
"Z"
      NResult
NEnv                     -> String
"E"
      (NPair NResult
a NResult
b)              -> String -> NResult -> NResult -> String
showTwo String
"P" NResult
a NResult
b
      NGate NResult
a NResult
b                -> String -> NResult -> NResult -> String
showTwo String
"G" NResult
a NResult
b
      NResult
NTrace                   -> String
"T"
      (NDefer (FragIndex Int
ind)) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"[", forall a. Show a => a -> String
show Int
ind, String
"]"]
      (NLeft NResult
x)                -> String
"L " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
      (NRight NResult
x)               -> String
"R " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
      (NSetEnv NResult
x)              -> String
"S " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
      (NAdd NResult
a NResult
b)               -> String -> NResult -> NResult -> String
showTwo String
"+" NResult
a NResult
b
      (NMult NResult
a NResult
b)              -> String -> NResult -> NResult -> String
showTwo String
"X" NResult
a NResult
b
      (NPow NResult
a NResult
b)               -> String -> NResult -> NResult -> String
showTwo String
"^" NResult
a NResult
b
      (NApp NResult
c NResult
i)               -> String -> NResult -> NResult -> String
showTwo String
"$" NResult
c NResult
i
      (NNum Int64
n)                 -> forall a. Show a => a -> String
show Int64
n --concat ["()"]
      (NToChurch NResult
c NResult
i)          -> String -> NResult -> NResult -> String
showTwo String
"<" NResult
c NResult
i
      (NOldDefer NResult
x)            -> String
"% " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
      (NTwiddle NResult
x)             -> String
"W " forall a. Semigroup a => a -> a -> a
<> NResult -> String
recur NResult
x
      NResult
NToNum                   -> String
"["

showNExprs :: NExprs -> String
showNExprs :: NExprs -> String
showNExprs (NExprs Map FragIndex NResult
m) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
  (\(FragIndex Int
k,NResult
v) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show Int
k, String
" ", Int -> Int -> NResult -> String
showOneNExpr Int
80 Int
2 NResult
v, String
"\n"])
  forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map FragIndex NResult
m

-- termMap, function->type lookup, root frag type
data TypeDebugInfo = TypeDebugInfo Term3 (FragIndex -> PartialType) PartialType

instance PrettyPrintable Term3 where
  showP :: Term3 -> State Int String
showP (Term3 Map FragIndex FragExprUR
termMap) = Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
-> State Int String
showFrag (FragExprUR
-> Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
unFragExprUR forall a b. (a -> b) -> a -> b
$ forall a. Map FragIndex a -> a
rootFrag Map FragIndex FragExprUR
termMap) where
    showFrag :: Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
-> State Int String
showFrag = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata CofreeF
  (FragExprF (RecursionSimulationPieces FragExprUR))
  LocTag
  (State Int String)
-> State Int String
showF
    showF :: CofreeF
  (FragExprF (RecursionSimulationPieces FragExprUR))
  LocTag
  (State Int String)
-> State Int String
showF (LocTag
_ CofreeT.:< FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
x) = FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
-> State Int String
sf FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
x
    showL :: CofreeF f a b -> String
showL (a
a CofreeT.:< f b
_) = forall a. Show a => a -> String
show a
a
    sf :: FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
-> State Int String
sf = \case
      FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
ZeroFragF -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Z"
      PairFragF State Int String
a State Int String
b -> String -> State Int String -> State Int String -> State Int String
indentWithTwoChildren' String
"P" State Int String
a State Int String
b
      FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
EnvFragF -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"E"
      SetEnvFragF State Int String
x -> String -> State Int String -> State Int String
indentWithOneChild' String
"S" State Int String
x
      DeferFragF FragIndex
fi -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FragIndex
fi Map FragIndex FragExprUR
termMap of
        Just FragExprUR
frag -> let f :: Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
f = FragExprUR
-> Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
unFragExprUR FragExprUR
frag
                     in String -> State Int String -> State Int String
indentWithOneChild' (String
"D" forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *} {b}. Show a => CofreeF f a b -> String
showL (forall t. Recursive t => t -> Base t t
project Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
f)) forall a b. (a -> b) -> a -> b
$ Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
-> State Int String
showFrag Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
f
        Maybe FragExprUR
z -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"PrettyPrint Term3 bad index found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Maybe FragExprUR
z
      FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
AbortFragF -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"A"
      GateFragF State Int String
l State Int String
r -> String -> State Int String -> State Int String -> State Int String
indentWithTwoChildren' String
"G" State Int String
l State Int String
r
      LeftFragF State Int String
x -> String -> State Int String -> State Int String
indentWithOneChild' String
"L" State Int String
x
      RightFragF State Int String
x -> String -> State Int String -> State Int String
indentWithOneChild' String
"R" State Int String
x
      FragExprF (RecursionSimulationPieces FragExprUR) (State Int String)
TraceFragF -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"T"
      AuxFragF RecursionSimulationPieces FragExprUR
x -> case RecursionSimulationPieces FragExprUR
x of
        SizingWrapper UnsizedRecursionToken
_ FragExprUR
x' -> String -> State Int String -> State Int String
indentWithOneChild' String
"?" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
-> State Int String
showFrag forall a b. (a -> b) -> a -> b
$ FragExprUR
-> Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
unFragExprUR FragExprUR
x'
        NestedSetEnvs UnsizedRecursionToken
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"%"

showTypeDebugInfo :: TypeDebugInfo -> String
showTypeDebugInfo :: TypeDebugInfo -> String
showTypeDebugInfo (TypeDebugInfo (Term3 Map FragIndex FragExprUR
m) FragIndex -> PartialType
lookup PartialType
rootType) =
  let termMap :: Map FragIndex FragExprURSansAnnotation
termMap = FragExprUR -> FragExprURSansAnnotation
forgetAnnotationFragExprUR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FragIndex FragExprUR
m
      showFrag :: FragIndex
-> PartialType
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showFrag (FragIndex Int
i) PartialType
ty FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
frag = forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (PartialType -> PrettyPartialType
PrettyPartialType PartialType
ty) forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> forall {p}.
p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr Integer
80 Int
2 FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
frag
      showExpr :: p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l Int
i =
        let recur :: FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
recur = p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l Int
i
            showTwo :: String
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showTwo String
c FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b =
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
c, String
"\n", Int -> String
indentation Int
i, p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a, String
"\n", Int -> String
indentation Int
i, p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b]
            showThree :: String
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showThree String
x FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
c =
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
x, String
"\n", Int -> String
indentation Int
i, p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a, String
"\n", Int -> String
indentation Int
i, p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b, String
"\n", Int -> String
indentation Int
i, p
-> Int
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showExpr p
l (Int
i forall a. Num a => a -> a -> a
+ Int
1) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
c]
        in \case
          FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
ZeroFrag                                   -> String
"Z"
          PairFrag FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b                               -> String
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showTwo String
"P" FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
a FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
b
          FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
EnvFrag                                    -> String
"E"
          SetEnvFrag FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x                               -> String
"S " forall a. Semigroup a => a -> a -> a
<> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
recur FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x
          DeferFrag (FragIndex Int
ind)                  -> String
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ind forall a. Semigroup a => a -> a -> a
<> String
"]"
          FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
AbortFrag                                  -> String
"A"
          GateFrag FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
l FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
r                               -> String
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showTwo String
"G" FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
l FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
r
          LeftFrag FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x                                 -> String
"L " forall a. Semigroup a => a -> a -> a
<> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
recur FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x
          RightFrag FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x                                -> String
"R " forall a. Semigroup a => a -> a -> a
<> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
recur FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x
          FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
TraceFrag                                  -> String
"T"
          AuxFrag (SizingWrapper UnsizedRecursionToken
_ (FragExprURSA FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x)) -> String
"?" forall a. Semigroup a => a -> a -> a
<> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
recur FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
x
          AuxFrag (NestedSetEnvs UnsizedRecursionToken
_)                  -> String
"%"
  in FragIndex
-> PartialType
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showFrag (Int -> FragIndex
FragIndex Int
0) PartialType
rootType (FragExprURSansAnnotation
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
unFragExprURSA forall a b. (a -> b) -> a -> b
$ forall a. Map FragIndex a -> a
rootFrag Map FragIndex FragExprURSansAnnotation
termMap) forall a. Semigroup a => a -> a -> a
<> String
"\n"
     forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(FragIndex
k, FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
v) -> FragIndex
-> PartialType
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
-> String
showFrag FragIndex
k (FragIndex -> PartialType
lookup FragIndex
k) FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
v forall a. Semigroup a => a -> a -> a
<> String
"\n")
                  (forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map FragExprURSansAnnotation
-> FragExpr (RecursionSimulationPieces FragExprURSansAnnotation)
unFragExprURSA forall a b. (a -> b) -> a -> b
$ Map FragIndex FragExprURSansAnnotation
termMap)

newtype PrettyIExpr = PrettyIExpr IExpr

instance Show PrettyIExpr where
  show :: PrettyIExpr -> String
show (PrettyIExpr IExpr
iexpr) = case IExpr
iexpr of
    p :: IExpr
p@(Pair IExpr
a IExpr
b) -> if IExpr -> Bool
isNum IExpr
p
      then forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ IExpr -> Int
g2i IExpr
p
      else forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show (IExpr -> PrettyIExpr
PrettyIExpr IExpr
a), String
",", forall a. Show a => a -> String
show (IExpr -> PrettyIExpr
PrettyIExpr IExpr
b), String
")"]
    IExpr
Zero -> String
"0"
    IExpr
x -> forall a. Show a => a -> String
show IExpr
x

indentSansFirstLine :: Int -> String -> String
indentSansFirstLine :: Int -> ShowS
indentSansFirstLine Int
i String
x = ShowS
removeLastNewLine String
res where
  res :: String
res = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ (\(String
s:[String]
ns) -> String
sforall a. a -> [a] -> [a]
:((Int -> String
indentation Int
i forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ns)) (String -> [String]
lines String
x)
  removeLastNewLine :: ShowS
removeLastNewLine String
str =
    case forall a. [a] -> [a]
reverse String
str of
      Char
'\n' : String
rest -> forall a. [a] -> [a]
reverse String
rest
      String
x           -> String
str

newtype PrettierIExpr = PrettierIExpr IExpr

instance Show PrettierIExpr where
  show :: PrettierIExpr -> String
show (PrettierIExpr IExpr
iexpr) = ShowS
removeRedundantParens forall a b. (a -> b) -> a -> b
$ forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base IExpr String -> String
alg IExpr
iexpr where
    removeRedundantParens :: String -> String
    removeRedundantParens :: ShowS
removeRedundantParens String
str = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ ShowS
removeRedundantParensOneLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
str
    filterOnce :: Eq a => a -> [a] -> [a]
    filterOnce :: forall a. Eq a => a -> [a] -> [a]
filterOnce a
y = \case
      []     -> []
      (a
x:[a]
xs) -> if a
x forall a. Eq a => a -> a -> Bool
== a
y then [a]
xs else a
x forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
filterOnce a
y [a]
xs
    removeRedundantParensOneLine :: String -> String
    removeRedundantParensOneLine :: ShowS
removeRedundantParensOneLine String
str =
      case (forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'(' String
str, forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
')' String
str) of
        (Just Int
x, Just Int
y) -> forall a. Eq a => a -> [a] -> [a]
filterOnce Char
')' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [a]
filterOnce Char
'(' forall a b. (a -> b) -> a -> b
$ String
str
        (Maybe Int, Maybe Int)
_                -> String
str
    alg :: Base IExpr String -> String
    alg :: Base IExpr String -> String
alg = \case
      PairF String
x String
y -> case (String
y, forall a. Read a => String -> Maybe a
readMaybe String
x :: Maybe Int) of
                     (String
"0", Just Int
x) -> forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
x forall a. Num a => a -> a -> a
+ Int
1
                     (String, Maybe Int)
_ -> String
"P\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
                     -- _ -> if (length . lines $ x) == 1 && (length . lines $ y) == 1
                     --        then "(" <> x <> ", " <> y  <> ")"
                     --        else "( " <> indentSansFirstLine 2 x <> "\n" <>
                     --             ", " <> indentSansFirstLine 2 y <> "\n" <>
                     --             ")"
      Base IExpr String
IExprF String
ZeroF -> String
"0"
      Base IExpr String
IExprF String
EnvF -> String
"E"
      Base IExpr String
IExprF String
TraceF -> String
"T"
      SetEnvF String
x -> String
"S\n" forall a. Semigroup a => a -> a -> a
<>
                   String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      DeferF String
x -> String
"D\n" forall a. Semigroup a => a -> a -> a
<>
                   String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      GateF String
x String
y -> String
"G\n" forall a. Semigroup a => a -> a -> a
<>
                   String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                   String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      PLeftF String
x -> String
"L\n" forall a. Semigroup a => a -> a -> a
<>
                  String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      PRightF String
x -> String
"R\n" forall a. Semigroup a => a -> a -> a
<>
                   String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"

newtype PrettyDataType = PrettyDataType DataType

showInternal :: DataType -> String
showInternal :: DataType -> String
showInternal at :: DataType
at@(ArrType DataType
_ DataType
_) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ DataType -> PrettyDataType
PrettyDataType DataType
at, String
")"]
showInternal DataType
t                = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> PrettyDataType
PrettyDataType forall a b. (a -> b) -> a -> b
$ DataType
t

instance Show PrettyDataType where
  show :: PrettyDataType -> String
show (PrettyDataType DataType
dt) = case DataType
dt of
    DataType
ZeroType -> String
"D"
    (ArrType DataType
a DataType
b) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [DataType -> String
showInternal DataType
a, String
" -> ", DataType -> String
showInternal DataType
b]
    (PairType DataType
a DataType
b) ->
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ DataType -> PrettyDataType
PrettyDataType DataType
a, String
",", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ DataType -> PrettyDataType
PrettyDataType DataType
b, String
")"]

newtype PrettyPartialType = PrettyPartialType PartialType

showInternalP :: PartialType -> String
showInternalP :: PartialType -> String
showInternalP at :: PartialType
at@(ArrTypeP PartialType
_ PartialType
_) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PartialType -> PrettyPartialType
PrettyPartialType PartialType
at, String
")"]
showInternalP PartialType
t                 = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialType -> PrettyPartialType
PrettyPartialType forall a b. (a -> b) -> a -> b
$ PartialType
t

instance Show PrettyPartialType where
  show :: PrettyPartialType -> String
show (PrettyPartialType PartialType
dt) = case PartialType
dt of
    PartialType
ZeroTypeP -> String
"Z"
    PartialType
AnyType -> String
"A"
    (ArrTypeP PartialType
a PartialType
b) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [PartialType -> String
showInternalP PartialType
a, String
" -> ", PartialType -> String
showInternalP PartialType
b]
    (PairTypeP PartialType
a PartialType
b) ->
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PartialType -> PrettyPartialType
PrettyPartialType PartialType
a, String
",", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PartialType -> PrettyPartialType
PrettyPartialType PartialType
b, String
")"]
    (TypeVariable LocTag
_ (-1)) -> String
"badType"
    (TypeVariable LocTag
_ Int
x) -> Char
'v' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
x

newtype PrettyPattern = PrettyPattern Pattern

instance Show PrettyPattern where
  show :: PrettyPattern -> String
show = \case
    (PrettyPattern (PatternInt Int
x)) -> forall a. Show a => a -> String
show Int
x
    (PrettyPattern (PatternVar String
x)) -> String
x
    (PrettyPattern (PatternString String
x)) ->  forall a. Show a => a -> String
show String
x
    (PrettyPattern (PatternPair Pattern
x Pattern
y)) -> String
"(" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> PrettyPattern
PrettyPattern forall a b. (a -> b) -> a -> b
$ Pattern
x) forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> PrettyPattern
PrettyPattern forall a b. (a -> b) -> a -> b
$ Pattern
y) forall a. Semigroup a => a -> a -> a
<> String
")"
    (PrettyPattern Pattern
PatternIgnore) -> String
"_"

newtype MultiLineShowUPT = MultiLineShowUPT UnprocessedParsedTerm
instance Show MultiLineShowUPT where
  show :: MultiLineShowUPT -> String
show (MultiLineShowUPT UnprocessedParsedTerm
upt) = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base UnprocessedParsedTerm String -> String
alg UnprocessedParsedTerm
upt where
    alg :: Base UnprocessedParsedTerm String -> String
    alg :: Base UnprocessedParsedTerm String -> String
alg = \case
      IntUPF Int
i -> String
"IntUP " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i
      VarUPF String
str -> String
"VarUP " forall a. Semigroup a => a -> a -> a
<> String
str
      StringUPF String
str -> String
"StringUP" forall a. Semigroup a => a -> a -> a
<> String
str
      PairUPF String
x String
y -> String
"PairUP" forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      (ITEUPF String
x String
y String
z) -> String
"ITEUP" forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
z forall a. Semigroup a => a -> a -> a
<> String
")"
      (AppUPF String
x String
y) -> String
"AppUP" forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      (LamUPF String
str String
y) -> String
"LamUP " forall a. Semigroup a => a -> a -> a
<> String
str forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      (ChurchUPF Int
x) -> String
"ChurchUP " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
x
      (LeftUPF String
x) -> String
"LeftUP \n" forall a. Semigroup a => a -> a -> a
<>
                       String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (RightUPF String
x) -> String
"RightUP \n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (TraceUPF String
x) -> String
"TraceUP \n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (UnsizedRecursionUPF String
x String
y String
z) -> String
"UnsizedRecursionUP" forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
z forall a. Semigroup a => a -> a -> a
<> String
")"
      (HashUPF String
x) -> String
"HashUP \n" forall a. Semigroup a => a -> a -> a
<>
                       String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (CheckUPF String
x String
y) -> String
"CheckUP" forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      (ListUPF []) -> String
"ListUP []"
      (ListUPF [String
x]) -> String
"ListUP [" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
"]"
      (ListUPF [String]
ls) -> String
"ListUP\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  [" forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String
unlines ((String
"  " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indentSansFirstLine Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ls)) forall a. Semigroup a => a -> a -> a
<>
                        String
"  ]"
      (LetUPF [(String, String)]
ls String
x) -> String
"LetUP\n" forall a. Semigroup a => a -> a -> a
<>
                         String
"  [ " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop Int
4 ([String] -> String
unlines ( (String
"  " forall a. Semigroup a => a -> a -> a
<>)
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indentSansFirstLine Int
3
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", " forall a. Semigroup a => a -> a -> a
<>)
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(String
x,String
y) -> String
"(" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x forall a. Num a => a -> a -> a
+ Int
4) String
y forall a. Semigroup a => a -> a -> a
<> String
")")
                                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
ls
                                                   )) forall a. Semigroup a => a -> a -> a
<>
                         String
"  ]\n" forall a. Semigroup a => a -> a -> a
<>
                         String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (CaseUPF String
x [(Pattern, String)]
ls) -> String
"CaseUP\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
")\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  [" forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop Int
3 ([String] -> String
unlines ( (String
"  " forall a. Semigroup a => a -> a -> a
<>)
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indentSansFirstLine Int
3
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", " forall a. Semigroup a => a -> a -> a
<>)
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Pattern
x,String
y) -> String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Pattern
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine ((forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Pattern
x) forall a. Num a => a -> a -> a
+ Int
4) String
y forall a. Semigroup a => a -> a -> a
<> String
")")
                                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pattern, String)]
ls
                                                   )) forall a. Semigroup a => a -> a -> a
<>
                          String
"  ]\n"

newtype PrettyUPT = PrettyUPT UnprocessedParsedTerm

instance Show PrettyUPT where
  show :: PrettyUPT -> String
show (PrettyUPT UnprocessedParsedTerm
upt) = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base UnprocessedParsedTerm String -> String
alg UnprocessedParsedTerm
upt where
    alg :: Base UnprocessedParsedTerm String -> String
    alg :: Base UnprocessedParsedTerm String -> String
alg = \case
      IntUPF Int
i -> forall a. Show a => a -> String
show Int
i
      VarUPF String
str -> String
str
      StringUPF String
str -> forall a. Show a => a -> String
show String
str
      PairUPF String
x String
y -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines (String
x forall a. Semigroup a => a -> a -> a
<> String
y)) forall a. Ord a => a -> a -> Bool
> Int
1
                       then String
"( " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
x forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                            String
", " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
y forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                            String
")"
                       else String
"(" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> String
y forall a. Semigroup a => a -> a -> a
<>String
")"
      (ITEUPF String
x String
y String
z) -> String
"if " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  then " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
7 String
y forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                          String
"  else " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
7 String
z
      (LetUPF [(String, String)]
ls String
x) ->
        String
"let " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
4 ([String] -> String
unlines ((String, String) -> String
assignList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
ls)) forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
        String
"in " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
3 String
x
          where
            assignList :: (String, String) -> String
            assignList :: (String, String) -> String
assignList (String
str, String
upt) = String
str forall a. Semigroup a => a -> a -> a
<> String
" = " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine (Int
3 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) String
upt
      (ListUPF []) -> String
"[]"
      (ListUPF [String
x]) -> String
"[" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
"]"
      (ListUPF [String]
ls) ->
        String
"[" forall a. Semigroup a => a -> a -> a
<> ShowS
removeFirstComma ([String] -> String
unlines (Int -> ShowS
indentSansFirstLine Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ls)) forall a. Semigroup a => a -> a -> a
<>
        String
"]"
          where
            removeFirstComma :: ShowS
removeFirstComma = \case
              (Char
',':String
str) -> String
str
              String
_         -> forall a. HasCallStack => String -> a
error String
"removeFirstComma: input does not start with a comma"
      (AppUPF String
x String
y) -> (if (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
x) forall a. Eq a => a -> a -> Bool
== Int
1 then String
x else String
"(" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
")") forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<>
                      if (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
y) forall a. Eq a => a -> a -> Bool
== Int
1 then String
y else String
"(" forall a. Semigroup a => a -> a -> a
<> String
y forall a. Semigroup a => a -> a -> a
<> String
")"
      (LamUPF String
str String
y) -> String
"\\ " forall a. Semigroup a => a -> a -> a
<> String
str forall a. Semigroup a => a -> a -> a
<> String
" -> " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine (Int
6 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) String
y
      (ChurchUPF Int
x) -> String
"$" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
x
      (LeftUPF String
x) -> String
"left (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
6 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (RightUPF String
x) -> String
"right (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
7 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (TraceUPF String
x) -> String
"trace (" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
7 String
x forall a. Semigroup a => a -> a -> a
<> String
")"
      (UnsizedRecursionUPF String
x String
y String
z) -> String
"{ " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
x forall a. Semigroup a => a -> a -> a
<>
                                     String
", " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
y forall a. Semigroup a => a -> a -> a
<>
                                     String
", " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
z forall a. Semigroup a => a -> a -> a
<>
                                     String
"}"
      (HashUPF String
x) -> String
"# " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
x
      (CaseUPF String
x [(Pattern, String)]
ls) -> String
"case " forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
" of\n" forall a. Semigroup a => a -> a -> a
<>
                        String
"  " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 ([String] -> String
unlines ((\(Pattern
p, String
r) -> Int -> ShowS
indentSansFirstLine Int
2 (forall a. Show a => a -> String
show (Pattern -> PrettyPattern
PrettyPattern Pattern
p) forall a. Semigroup a => a -> a -> a
<> String
" -> " forall a. Semigroup a => a -> a -> a
<> String
r)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pattern, String)]
ls))
      (CheckUPF String
x String
y) -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines (String
x forall a. Semigroup a => a -> a -> a
<> String
y)) forall a. Ord a => a -> a -> Bool
> Int
1
                          then String
"(" forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
2 String
y forall a. Semigroup a => a -> a -> a
<> String
" : " forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
                               String
"    " forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
indentSansFirstLine Int
4 String
y forall a. Semigroup a => a -> a -> a
<> String
")"
                          else String
"(" forall a. Semigroup a => a -> a -> a
<> String
y forall a. Semigroup a => a -> a -> a
<> String
" : " forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
")"