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

Factor the base & stem assignment into the where clause.

Browse Source
This commit is contained in:
Rob Rix 2016-08-10 15:57:55 -04:00
parent e162987c26
commit 704ff4db08
1 changed files with 2 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Data/RandomWalkSimilarity.hs
View File

@ -68,8 +68,9 @@ pqGramDecorator :: Traversable f
-> Cofree f (Record (Gram label ': fields)) -- ^ The decorated term. -> Cofree f (Record (Gram label ': fields)) -- ^ The decorated term.
pqGramDecorator getLabel p q = cata algebra pqGramDecorator getLabel p q = cata algebra
where algebra term = let label = getLabel term in where algebra term = let label = getLabel term in
cofree ((gram label .: headF term) :< (`evalState` (siblingLabels (tailF term))) (for (tailF term) (assignLabels label))) cofree ((gram label .: headF term) :< assignParentAndSiblingLabels (tailF term) label)
gram label = Gram (padToSize p []) (padToSize q (pure (Just label))) gram label = Gram (padToSize p []) (padToSize q (pure (Just label)))
assignParentAndSiblingLabels functor label = (`evalState` (siblingLabels functor)) (for functor (assignLabels label))
assignLabels :: label -> Cofree f (Record (Gram label ': fields)) -> State [Maybe label] (Cofree f (Record (Gram label ': fields))) assignLabels :: label -> Cofree f (Record (Gram label ': fields)) -> State [Maybe label] (Cofree f (Record (Gram label ': fields)))
assignLabels label a = case runCofree a of assignLabels label a = case runCofree a of
RCons gram rest :< functor -> do RCons gram rest :< functor -> do