2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DefaultSignatures #-}
4 {-# LANGUAGE FlexibleContexts #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 {-# LANGUAGE Rank2Types #-}
7 {-# LANGUAGE TypeFamilies #-}
8 module Hdoc.TCT.Debug where
10 import Control.Monad (Monad(..), mapM)
12 import Data.Eq (Eq(..))
13 import Data.Foldable (toList, null)
14 import Data.Function (($), (.), id)
16 import Data.List.NonEmpty (NonEmpty(..))
17 import Data.Maybe (Maybe(..))
19 import Data.Semigroup (Semigroup(..))
20 import Data.Sequence (Seq)
21 import Data.String (String)
22 import Data.Text (Text)
23 import Data.TreeSeq.Strict (Tree(..))
25 import Text.Show (Show(..))
26 import qualified Control.Monad.Trans.Reader as R
27 import qualified Data.List as List
28 import qualified Data.Text.Lazy as TL
29 import qualified Debug.Trace as Trace
30 import qualified Text.Megaparsec as P
35 debug :: String -> a -> a
38 debug0 :: Pretty a => String -> a -> a
39 debug0 m a = Trace.trace (m <> ": " <> runPretty 2 a) a
41 debug1 :: (Pretty r, Pretty a) => String -> String -> (a -> r) -> (a -> r)
43 (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
44 Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> runPretty 2 a) f
47 debug1_ :: (Pretty r, Pretty a) => String -> (String,a) -> r -> r
49 Trace.trace ("[ " <> nf <> ":\n " <> na <> " = " <> runPretty 2 a) $
50 Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
53 debug2 :: (Pretty r, Pretty a, Pretty b) => String -> String -> String -> (a -> b -> r) -> (a -> b -> r)
54 debug2 nf na nb f a b =
55 (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
58 <> "\n " <> na <> " = " <> runPretty 2 a
59 <> "\n " <> nb <> " = " <> runPretty 2 b
62 debug2_ :: (Pretty r, Pretty a, Pretty b) => String -> (String,a) -> (String,b) -> r -> r
63 debug2_ nf (na,a) (nb,b) r =
66 <> "\n " <> na <> " = " <> runPretty 2 a
67 <> "\n " <> nb <> " = " <> runPretty 2 b
69 Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
72 debug3 :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> String -> String -> String -> (a -> b -> c -> r) -> (a -> b -> c -> r)
73 debug3 nf na nb nc f a b c =
74 (\r -> Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) r) $
77 <> "\n " <> na <> " = " <> runPretty 2 a
78 <> "\n " <> nb <> " = " <> runPretty 2 b
79 <> "\n " <> nc <> " = " <> runPretty 2 c
82 debug3_ :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> (String,a) -> (String,b) -> (String,c) -> r -> r
83 debug3_ nf (na,a) (nb,b) (nc,c) r =
86 <> "\n " <> na <> " = " <> runPretty 2 a
87 <> "\n " <> nb <> " = " <> runPretty 2 b
88 <> "\n " <> nc <> " = " <> runPretty 2 c
90 Trace.trace ("] " <> nf <> ": " <> runPretty 2 r) $
95 , P.ShowToken (P.Token s)
96 , P.ShowErrorComponent e
100 String -> P.ParsecT e s m a -> P.ParsecT e s m a
104 debug :: String -> a -> a
108 debug0 :: Pretty a => String -> a -> a
110 {-# INLINE debug0 #-}
112 debug1 :: (Pretty r, Pretty a) => String -> String -> (a -> r) -> (a -> r)
114 {-# INLINE debug1 #-}
116 debug1_ :: (Pretty r, Pretty a) => String -> (String,a) -> r -> r
118 {-# INLINE debug1_ #-}
120 debug2 :: (Pretty r, Pretty a, Pretty b) => String -> String -> String -> (a -> b -> r) -> (a -> b -> r)
121 debug2 _nf _na _nb = id
122 {-# INLINE debug2 #-}
124 debug2_ :: (Pretty r, Pretty a, Pretty b) => String -> (String,a) -> (String,b) -> r -> r
125 debug2_ _nf _a _b = id
126 {-# INLINE debug2_ #-}
128 debug3 :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> String -> String -> String -> (a -> b -> c -> r) -> (a -> b -> c -> r)
129 debug3 _nf _na _nb _nc = id
130 {-# INLINE debug3 #-}
132 debug3_ :: (Pretty r, Pretty a, Pretty b, Pretty c) => String -> (String,a) -> (String,b) -> (String,c) -> r -> r
133 debug3_ _nf _a _b _c = id
134 {-# INLINE debug3_ #-}
138 , P.ShowToken (P.Token s)
139 , P.ShowErrorComponent e
143 String -> P.ParsecT e s m a -> P.ParsecT e s m a
145 {-# INLINE debugParser #-}
150 pretty :: a -> R.Reader Int String
151 default pretty :: Show a => a -> R.Reader Int String
152 pretty = return . show
154 runPretty :: Pretty a => Int -> a -> String
155 runPretty i a = pretty a `R.runReader` i
160 instance Pretty TL.Text
161 instance Pretty P.Pos
162 instance (Pretty a, Pretty b) => Pretty (a,b) where
165 a' <- R.local (+2) $ pretty a
166 b' <- R.local (+2) $ pretty b
168 (if i == 0 then "" else "\n") <>
169 List.replicate i ' ' <> "( " <> a' <>
170 "\n" <> List.replicate i ' ' <> ", " <> b' <>
171 "\n" <> List.replicate i ' ' <> ") "
172 instance Pretty a => Pretty [a] where
173 pretty [] = return "[]"
176 s <- R.local (+2) $ mapM pretty as
178 (if i == 0 then "" else "\n") <>
179 List.replicate i ' ' <> "[ " <>
180 List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
181 "\n" <> List.replicate i ' ' <> "] "
182 instance Pretty a => Pretty (NonEmpty a) where
183 pretty = pretty . toList
184 instance Pretty a => Pretty (Seq a) where
186 | null ss = return "[]"
190 s <- R.local (+2) $ mapM pretty as
192 (if i == 0 then "" else "\n") <>
193 List.replicate i ' ' <> "[ " <>
194 List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
195 "\n" <> List.replicate i ' ' <> "] "
196 instance Pretty a => Pretty (Maybe a) where
197 pretty Nothing = return "Nothing"
201 instance Show a => Pretty (Tree a) where
202 pretty (Tree n ts) = do
203 s <- R.local (+2) (pretty ts)
204 return $ "Tree "<>showsPrec 11 n ""<>" "<>s