Add HTML5 rendition of Head.

[doclang.git] / Language / TCT / Debug.hs

diff --git a/Language/TCT/Debug.hs b/Language/TCT/Debug.hs
index b4d81c1548458f96b57cc847cc235e551bc43e33..df0b2fd75ebd291d487747ebb4b4acbb4daa296c 100644 (file)
--- a/Language/TCT/Debug.hs
+++ b/Language/TCT/Debug.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -10,8 +9,9 @@ module Language.TCT.Debug where
 
 import Control.Monad (Monad(..), mapM)
 import Data.Bool
+import Data.Eq (Eq(..))
 import Data.Foldable (toList, null)
-import Data.Function (($), (.))
+import Data.Function (($), (.), id)
 import Data.Int (Int)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (Maybe(..))
@@ -26,68 +26,68 @@ import Text.Show (Show(..))
 import qualified Control.Monad.Trans.Reader as R
 import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
+import qualified Debug.Trace as Trace
 import qualified Text.Megaparsec as P
 
 -- * Debug
 #if DEBUG
-import qualified Debug.Trace as Trace
 
 debug :: String -> a -> a
 debug = Trace.trace
 
 debug0 :: Pretty a => String -> a -> a
-debug0 m a = Trace.trace (m <> ": " <> R.runReader (pretty a) 2) a
+debug0 m a = Trace.trace (m <> ": " <> runPretty 2 a) a
 
 debug1 :: (Pretty r, Pretty a) => String -> String -> (a -> r) -> (a -> r)
 debug1 nf na f a =
-       (\r -> Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) r) $
-       (Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> R.runReader (pretty a) 2) f)
+       (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
+       Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> runPretty 2 a) f
        a
 
 debug1_ :: (Pretty r, Pretty a) => String -> (String,a) -> r -> r
 debug1_ nf (na,a) r =
-       Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> R.runReader (pretty a) 2) $
-       Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) $
+       Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> runPretty 2 a) $
+       Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
        r
 
 debug2 :: (Pretty r, Pretty a, Pretty b) => String -> String -> String -> (a -> b -> r) -> (a -> b -> r)
 debug2 nf na nb f a b =
-       (\r -> Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) r) $
+       (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
        Trace.trace
         ("[ " <> nf <> ":"
-                <> "\n " <> na <> " = " <> R.runReader (pretty a) 2
-                <> "\n " <> nb <> " = " <> R.runReader (pretty b) 2
+                <> "\n " <> na <> " = " <> runPretty 2 a
+                <> "\n " <> nb <> " = " <> runPretty 2 b
         ) f a b
 
 debug2_ :: (Pretty r, Pretty a, Pretty b) => String -> (String,a) -> (String,b) -> r -> r
 debug2_ nf (na,a) (nb,b) r =
        Trace.trace
         ("[ " <> nf <> ":"
-                <> "\n " <> na <> " = " <> R.runReader (pretty a) 2
-                <> "\n " <> nb <> " = " <> R.runReader (pretty b) 2
+                <> "\n " <> na <> " = " <> runPretty 2 a
+                <> "\n " <> nb <> " = " <> runPretty 2 b
         ) $
-       Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) $
+       Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
        r
 
 debug3 :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> String -> String -> String -> (a -> b -> c -> r) -> (a -> b -> c -> r)
 debug3 nf na nb nc f a b c =
-       (\r -> Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) r) $
+       (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
        Trace.trace
         ("[ " <> nf <> ":"
-                <> "\n " <> na <> " = " <> R.runReader (pretty a) 2
-                <> "\n " <> nb <> " = " <> R.runReader (pretty b) 2
-                <> "\n " <> nc <> " = " <> R.runReader (pretty c) 2
+                <> "\n " <> na <> " = " <> runPretty 2 a
+                <> "\n " <> nb <> " = " <> runPretty 2 b
+                <> "\n " <> nc <> " = " <> runPretty 2 c
         ) f a b c
 
 debug3_ :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> (String,a) -> (String,b) -> (String,c) -> r -> r
 debug3_ nf (na,a) (nb,b) (nc,c) r =
        Trace.trace
         ("[ " <> nf <> ":"
-                <> "\n " <> na <> " = " <> R.runReader (pretty a) 2
-                <> "\n " <> nb <> " = " <> R.runReader (pretty b) 2
-                <> "\n " <> nc <> " = " <> R.runReader (pretty c) 2
+                <> "\n " <> na <> " = " <> runPretty 2 a
+                <> "\n " <> nb <> " = " <> runPretty 2 b
+                <> "\n " <> nc <> " = " <> runPretty 2 c
         ) $
-       Trace.trace ("] " <> nf <> ": " <> R.runReader (pretty r) 2) $
+       Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
        r
 
 debugParser ::
@@ -100,7 +100,6 @@ debugParser ::
  String -> P.Parsec e s a -> P.Parsec e s a
 debugParser = P.dbg
 #else
-import Data.Function (id)
 
 debug :: String -> a -> a
 debug _m = id
@@ -151,17 +150,23 @@ class Pretty a where
        pretty :: a -> R.Reader Int String
        default pretty :: Show a => a -> R.Reader Int String
        pretty = return . show
+
+runPretty :: Pretty a => Int -> a -> String
+runPretty i a = pretty a `R.runReader` i
+
 instance Pretty Bool
 instance Pretty Int
 instance Pretty Text
 instance Pretty TL.Text
+instance Pretty P.Pos
 instance (Pretty a, Pretty b) => Pretty (a,b) where
        pretty (a,b) = do
                i <- R.ask
                a' <- R.local (+2) $ pretty a
                b' <- R.local (+2) $ pretty b
                return $
-                       "\n" <> List.replicate i ' ' <> "( " <> a' <>
+                       (if i == 0 then "" else "\n") <>
+                       List.replicate i ' ' <> "( " <> a' <>
                        "\n" <> List.replicate i ' ' <> ", " <> b' <>
                        "\n" <> List.replicate i ' ' <> ") "
 instance Pretty a => Pretty [a] where
@@ -170,7 +175,8 @@ instance Pretty a => Pretty [a] where
                i <- R.ask
                s <- R.local (+2) $ mapM pretty as
                return $
-                       "\n" <> List.replicate i ' ' <> "[ " <>
+                       (if i == 0 then "" else "\n") <>
+                       List.replicate i ' ' <> "[ " <>
                        List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
                        "\n" <> List.replicate i ' ' <> "] "
 instance Pretty a => Pretty (NonEmpty a) where
@@ -183,7 +189,8 @@ instance Pretty a => Pretty (Seq a) where
                i <- R.ask
                s <- R.local (+2) $ mapM pretty as
                return $
-                       "\n" <> List.replicate i ' ' <> "[ " <>
+                       (if i == 0 then "" else "\n") <>
+                       List.replicate i ' ' <> "[ " <>
                        List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
                        "\n" <> List.replicate i ' ' <> "] "
 instance Pretty a => Pretty (Maybe a) where