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

Pad root labels out.

Browse Source
This commit is contained in:
Rob Rix 2016-08-08 16:47:33 -04:00
parent 3d4ea56ff3
commit 0cfb700c23
1 changed files with 1 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Data/RandomWalkSimilarity.hs
View File

@ -88,7 +88,7 @@ decorateTermWithPGram p = ana coalgebra . (,) []
decorateTermWithPQGram :: Traversable f => Int -> Cofree f (Record (Gram label ': fields)) -> Cofree f (Record (Gram label ': fields))
decorateTermWithPQGram q = cata algebra
where algebra :: Traversable f => CofreeF f (Record (Gram label ': fields)) (Cofree f (Record (Gram label ': fields))) -> Cofree f (Record (Gram label ': fields))
algebra (RCons gram rest :< functor) = cofree ((gram .: rest) :< (`evalState` (foldMap (base . rhead . extract) functor)) (for functor $ \ a -> case runCofree a of
algebra (RCons gram rest :< functor) = cofree ((gram { base = padToSize q (base gram) } .: rest) :< (`evalState` (foldMap (base . rhead . extract) functor)) (for functor $ \ a -> case runCofree a of
RCons gram rest :< functor -> do labels <- get
put (drop 1 labels)
pure $! cofree ((gram { base = padToSize q labels } .: rest) :< functor)))