mirror of
https://github.com/github/semantic.git
synced 2024-12-22 22:31:36 +03:00
Pad root labels out.
This commit is contained in:
parent
3d4ea56ff3
commit
0cfb700c23
@ -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 :: Traversable f => Int -> Cofree f (Record (Gram label ': fields)) -> Cofree f (Record (Gram label ': fields))
|
||||||
decorateTermWithPQGram q = cata algebra
|
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))
|
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
|
RCons gram rest :< functor -> do labels <- get
|
||||||
put (drop 1 labels)
|
put (drop 1 labels)
|
||||||
pure $! cofree ((gram { base = padToSize q labels } .: rest) :< functor)))
|
pure $! cofree ((gram { base = padToSize q labels } .: rest) :< functor)))
|
||||||
|
Loading…
Reference in New Issue
Block a user