move pretty stuff for DimEq

lib/Quox/Syntax/DimEq.idr

@@ -4,6 +4,8 @@ import public Quox.Syntax.Var
 import public Quox.Syntax.Dim
 import public Quox.Syntax.Subst
 import public Quox.Context
+import Quox.Pretty
+import Quox.Name
 
 import Data.Maybe
 import Data.Nat
@@ -216,6 +218,49 @@ setSelf (B i)    (C eqs) with (compareP i i) | (compare i.nat i.nat)
   _ | IsGT gt | GT = absurd gt
 
 
+private
+prettyDVars : Pretty.HasEnv m => m (SnocList (Doc HL))
+prettyDVars = map (pretty0 False . DV) <$> asks dnames
+
+private
+prettyCst : (PrettyHL a, PrettyHL b, Pretty.HasEnv m) => a -> b -> m (Doc HL)
+prettyCst p q = do
+  p <- pretty0M p
+  q <- pretty0M q
+  pure $ hsep [p, hl Syntax "=", q]
+
+export
+PrettyHL (DimEq' d) where
+  prettyM eqs {m} = do
+    vars <- prettyDVars
+    eqs  <- go eqs
+    let prec = if length vars <= 1 && null eqs then Arg else Outer
+    parensIfM prec $ align $ fillSep $ punctuate comma $ toList $ vars ++ eqs
+  where
+    tail : SnocList a -> SnocList a
+    tail [<] = [<]
+    tail (xs :< _) = xs
+
+    go : DimEq' d' -> m (SnocList (Doc HL))
+    go [<]              = pure [<]
+    go (eqs :< Nothing) = local {dnames $= tail} $ go eqs
+    go (eqs :< Just p)  = do
+      eq  <- prettyCst (BV {d = 1} 0) (weakD p)
+      eqs <- local {dnames $= tail} $ go eqs
+      pure $ eqs :< eq
+
+export
+PrettyHL (DimEq d) where
+  prettyM ZeroIsOne = parensIfM Outer $
+    align $ fillSep $ punctuate comma $ toList $
+    !prettyDVars :< !(prettyCst Zero One)
+  prettyM (C eqs)   = prettyM eqs
+
+export
+prettyDimEq : NContext d -> DimEq d -> Doc HL
+prettyDimEq ds = pretty0With False (toSnocList' ds) [<]
+
+
 public export
 wf' : DimEq' d -> Bool
 wf' [<]                 = True