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

Add a Message1 instance for Term

Browse Source
This commit is contained in:
joshvera 2018-05-24 17:32:42 -04:00
parent 800f2bc858
commit 0fb3ea0c84
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Data/Term.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators #-}
{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables #-}
module Data.Term
( Term(..)
, termIn
@ -16,6 +16,7 @@ import Data.Aeson
import Data.JSON.Fields
import Data.Record
import Text.Show
import Proto3.Suite.Class
-- | A Term with an abstract syntax tree and an annotation.
newtype Term syntax ann = Term { unTerm :: TermF syntax ann (Term syntax ann) }
@ -78,6 +79,11 @@ instance Show1 f => Show1 (Term f) where
instance (Show1 f, Show a) => Show (Term f a) where
showsPrec = showsPrec1
instance (Message1 f) => Message (Term f ()) where
encodeMessage num (Term (In a f)) = liftEncodeMessage encodeMessage num f
decodeMessage num = fmap (termIn ()) $ liftDecodeMessage decodeMessage num
dotProto _ = liftDotProto (dotProto @(Term f ())) (Proxy @f)
instance Ord1 f => Ord1 (Term f) where
liftCompare comp = go where go t1 t2 = liftCompare2 comp go (unTerm t1) (unTerm t2)