Commit 6735c0fa authored by Juan Pablo Garcia Garland's avatar Juan Pablo Garcia Garland
Browse files

now traces are not visible in type errors if they are empty, tested

parent 482a99a2
......@@ -97,7 +97,7 @@ an sloppy error:
> => Require (OpEqCol' 'False c c') ctx
> combine' f f' = req (Proxy @( '[ Text "combining.." ] )) (OpCombine f f')
> combine' f f' = req (Proxy @( '[ Text "combining"] )) (OpCombine f f')
combine' (Circle 1 1 1) (Sphere 1 1 1 1) ->
......
......@@ -155,23 +155,30 @@ data OpError (m :: ErrorMessage) :: Type where {}
-- | Failing and printing of an |OpError| requirement.
instance (TypeError
(Text "trace: " :<>: ShowCTX ctx))
-- (Text "Error: " :<>: m :$$:
-- If (ShowCTX ctx == Text "")
-- (Text "")
-- (Text "trace: " :<>: ShowCTX ctx)))
(Text "Error: " :<>: m :$$:
If (IsEmptyCtx ctx)
(Text "")
(Text "trace: " :<>: ShowCTX ctx)))
=>
Require (OpError m) ctx where
type ReqR (OpError m) = ()
req _ _ = error "unreachable"
type family IsEmptyCtx (ms :: [ErrorMessage]) :: Bool where
IsEmptyCtx '[] = True
IsEmptyCtx (m ': ms) = IsEmptyMsg m && IsEmptyCtx ms
-- | Formatting of context printing.
type family IsEmptyMsg (m :: ErrorMessage) :: Bool where
IsEmptyMsg (Text "") = True
IsEmptyMsg (l :<>: r) = IsEmptyMsg l && IsEmptyMsg r
IsEmptyMsg other = False
-- -- | Formatting of context printing.
type family ShowCTX (ctx :: [ErrorMessage]) :: ErrorMessage where
ShowCTX '[] = Text ""
ShowCTX (Text m ': ms) =
Text (AppendSymbol m (FromText (ShowCTX ms)))
ShowCTX (m ': ms) = m :$$: ShowCTX ms
type family FromText (t :: ErrorMessage) :: Symbol where
FromText (Text t) = t
......@@ -222,3 +229,17 @@ type family Equ (a :: k) (b :: k) :: Bool
emptyCtx = Proxy :: Proxy '[ Text ""]
type Lala = ShowCTX
'[ ((('GHC.TypeLits.Text "syndef("
'GHC.TypeLits.:<>: ((('GHC.TypeLits.Text "Attribute "
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text "cst")
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text ":")
'GHC.TypeLits.:<>: 'GHC.TypeLits.ShowType String))
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text ", ")
'GHC.TypeLits.:<>: ((('GHC.TypeLits.Text "Non-Terminal "
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text "Rose")
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text "::Production ")
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text "Node"))
'GHC.TypeLits.:<>: 'GHC.TypeLits.Text ")" ]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment