github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-18 20:31:55 +03:00
Code Issues Projects Releases Wiki Activity

Define Term printing via Show1.

Browse Source
This commit is contained in:
Rob Rix 2017-09-08 16:58:15 +01:00
parent a8f0a965c3
commit 3231b16399
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/Syntax/Assignment.hs
View File

@ -309,7 +309,7 @@ data State ast grammar = State
}
deriving instance (Eq grammar, Eq1 ast) => Eq (State ast grammar)
deriving instance (Show grammar, Show (ast (AST ast grammar))) => Show (State ast grammar)
deriving instance (Show grammar, Show1 ast) => Show (State ast grammar)
makeState :: [AST ast grammar] -> State ast grammar
makeState = State 0 (Info.Pos 1 1) []
@ -369,7 +369,7 @@ instance (Eq grammar, Eq1 ast) => Alternative (Assignment ast grammar) where
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = tracing (Many a) `Then` return
instance (Eq grammar, Eq1 ast, Show grammar, Show (ast (AST ast grammar))) => Parsing (Assignment ast grammar) where
instance (Eq grammar, Eq1 ast, Show grammar, Show1 ast) => Parsing (Assignment ast grammar) where
try :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
try = id
@ -395,7 +395,7 @@ instance MonadError (Error (Either String grammar)) (Assignment ast grammar) whe
instance Show1 f => Show1 (Tracing f) where
liftShowsPrec sp sl d = liftShowsPrec sp sl d . runTracing
instance (Show grammar, Show (ast (AST ast grammar))) => Show1 (AssignmentF ast grammar) where
instance (Show grammar, Show1 ast) => Show1 (AssignmentF ast grammar) where
liftShowsPrec sp sl d a = case a of
End -> showString "End" . showChar ' ' . sp d ()
Advance -> showString "Advance" . showChar ' ' . sp d ()

7
src/Term.hs
View File

@ -114,8 +114,11 @@ instance Eq1 f => Eq1 (Term f) where
instance (Eq1 f, Eq a) => Eq (Term f a) where
(==) = eq1
instance (Show (f (Term f a)), Show a) => Show (Term f a) where
showsPrec d (a :< f) = showParen (d > 5) $ showsPrec 6 a . showString " :< " . showsPrec 5 f
instance Show1 f => Show1 (Term f) where
liftShowsPrec spA slA = go where go d (a :< f) = showParen (d > 5) $ spA 6 a . showString " :< " . liftShowsPrec go (liftShowList spA slA) 5 f
instance (Show1 f, Show a) => Show (Term f a) where
showsPrec = showsPrec1
instance Functor f => Bifunctor (TermF f) where
bimap f g (a :<< r) = f a :<< fmap g r