github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-29 02:44:36 +03:00
Code Issues Projects Releases Wiki Activity

Term doesn't need to know about Record

Browse Source
This commit is contained in:
Timothy Clem 2018-09-21 09:42:24 -07:00
parent d656988dd0
commit dfe8c842ed
2 changed files with 4 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/Term.hs
View File

@ -10,14 +10,12 @@ module Data.Term
, termSize , termSize
, hoistTerm , hoistTerm
, hoistTermF , hoistTermF
, stripTerm
, Annotated (..) , Annotated (..)
) where ) where
import Prologue import Prologue
import Data.Aeson import Data.Aeson
import Data.JSON.Fields import Data.JSON.Fields
import Data.Record
import Text.Show import Text.Show
import qualified Data.Sum as Sum import qualified Data.Sum as Sum
import Proto3.Suite.Class import Proto3.Suite.Class
@ -71,10 +69,6 @@ hoistTerm f = go where go (Term r) = Term (hoistTermF f (fmap go r))
hoistTermF :: (forall a. f a -> g a) -> TermF f a b -> TermF g a b hoistTermF :: (forall a. f a -> g a) -> TermF f a b -> TermF g a b
hoistTermF f = go where go (In a r) = In a (f r) hoistTermF f = go where go (In a r) = In a (f r)
-- | Strips the head annotation off a term annotated with non-empty records.
stripTerm :: Functor f => Term f (Record (h ': t)) -> Term f (Record t)
stripTerm = fmap rtail
type instance Base (Term f a) = TermF f a type instance Base (Term f a) = TermF f a

4
test/Diffing/Algorithm/RWS/Spec.hs
View File

@ -41,3 +41,7 @@ spec = parallel $ do
where decorate = defaultFeatureVectorDecorator where decorate = defaultFeatureVectorDecorator
diffThese = these deleting inserting replacing diffThese = these deleting inserting replacing
-- | Strips the head annotation off a term annotated with non-empty records.
stripTerm :: Functor f => Term f (Record (h ': t)) -> Term f (Record t)
stripTerm = fmap rtail