Как реализовать функцию типа takeWhile с помощью комбинаторов Conduit?

Я пытаюсь реализовать функцию, которая сочетает в себе идеи groupBy и takeWhile, а также использует последнюю внутренне. В частности, он сгруппирует все элементы, которые последовательно возвращают True в текущем предикате, в виде списка, затем он продолжит делать то же самое со следующим предикатом и так далее:

   takeWhileGrouped :: (Monad m, MonoFoldable mono) =>
      ([Element mono -> Bool]) -> ConduitT (Element mono) [Element mono] m ()
    takeWhileGrouped preds = go preds
      where
        go (pred:nextPreds) = yield (goIter pred) >> go nextPreds
        goIter pred = takeWhile pred .| sinkList

Вполне вероятно, что эта реализация страдает от других проблем, но на данном этапе я получаю ошибку компиляции, с которой я не уверен, как поступить (почему mono0 не может быть идентифицирован с mono?); это из-за того, что не используется какое-то языковое расширение, или есть другая проблема?

    • Couldn't match type ‘Element mono0’ with ‘Element mono’
      Expected type: [Element mono -> Bool]
                     -> ConduitT (Element mono) [Element mono] m ()
        Actual type: [Element mono0 -> Bool]
                     -> ConduitT (Element mono0) [Element mono0] m ()
      NB: ‘Element’ is a non-injective type family
      The type variable ‘mono0’ is ambiguous
    • In the ambiguity check for ‘takeWhileGrouped’
      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
      In the type signature:
        takeWhileGrouped :: (Monad m, MonoFoldable mono) =>
                            ([Element mono -> Bool])
                            -> ConduitT (Element mono) [Element mono] m ()
    |
140 | takeWhileGrouped :: (Monad m, MonoFoldable mono) =>
    |                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...

Обновление 1

Включение AllowAmbiguousTypes действительно устраняет ошибку, но я отмечу, что в библиотека комбинаторов кажется ненужной.

Теперь настоящие проблемы проявляются:

    • Couldn't match type ‘ConduitT a0 c0 m0 [b0]’
                     with ‘[Element mono]’
      Expected type: ConduitT (Element mono) [Element mono] m ()
        Actual type: ConduitT
                       (Element seq0) (ConduitM a0 c0 m0 [b0]) m ()
    • In the expression: go preds
      In an equation for ‘takeWhileGrouped’:
          takeWhileGrouped preds
            = go preds
            where
                go (pred : nextPreds) = yield (goIter pred) >> go nextPreds
                goIter pred = takeWhile pred .| sinkList
    • Relevant bindings include
        preds :: [Element mono -> Bool]
          (bound at src/FDS/Data/Conduits.hs:143:18)
        takeWhileGrouped :: [Element mono -> Bool]
                            -> ConduitT (Element mono) [Element mono] m ()
          (bound at src/FDS/Data/Conduits.hs:143:1)
    |
143 | takeWhileGrouped preds = go preds
    |                          ^^^^^^^^


    • Couldn't match type ‘seq -> seq’ with ‘ConduitT a b m1 ()’
      Expected type: ConduitM a b m1 ()
        Actual type: seq -> seq
    • Probable cause: ‘takeWhile’ is applied to too few arguments
      In the first argument of ‘(.|)’, namely ‘takeWhile pred’
      In the expression: takeWhile pred .| sinkList
      In an equation for ‘goIter’:
          goIter pred = takeWhile pred .| sinkList
    • Relevant bindings include
        pred :: Element seq -> Bool
          (bound at src/FDS/Data/Conduits.hs:146:12)
        goIter :: (Element seq -> Bool) -> ConduitM a c m1 [b]
          (bound at src/FDS/Data/Conduits.hs:146:5)
    |
146 |     goIter pred = takeWhile pred .| sinkList
    |                   ^^^^^^^^^^^^^^

Обновление 2

Я использовал неправильный takeWhile, теперь использую CC.takeWhile от Conduit Cominators, в настоящее время у меня осталось:

    • Couldn't match type ‘ConduitT
                             (Element mono) c0 m0 [Element mono]’
                     with ‘[Element mono]’
      Expected type: ConduitT (Element mono) [Element mono] m ()
        Actual type: ConduitT
                       (Element mono) (ConduitM (Element mono) c0 m0 [Element mono]) m ()
    • In the expression: go preds
      In an equation for ‘takeWhileGrouped’:
          takeWhileGrouped preds
            = go preds
            where
                go (pred : nextPreds) = yield (goIter pred) >> go nextPreds
                goIter pred = CM.takeWhile pred .| sinkList
    • Relevant bindings include
        preds :: [Element mono -> Bool]
          (bound at src/FDS/Data/Conduits.hs:144:18)
        takeWhileGrouped :: [Element mono -> Bool]
                            -> ConduitT (Element mono) [Element mono] m ()
          (bound at src/FDS/Data/Conduits.hs:144:1)
    |
144 | takeWhileGrouped preds = go preds
    |                          ^^^^^^^^


Обновление 3

Было несколько проблем с API комбинатора, которые нужно было исправить, но по крайней мере одна все еще остается:

takeWhileGrouped :: forall m mono. (Monad m, MonoFoldable mono) =>
  ([Element mono -> Bool]) -> ConduitT (Element mono) [Element mono] m ()
takeWhileGrouped preds = go preds
  where
    go (pred:nextPreds) = yieldM (goIter pred) >> go nextPreds
    go [] = yield []
    goIter :: (Element mono -> Bool) -> m ([Element mono])
    goIter pred = (CC.takeWhile pred) .| sinkList & runConduitRes

Неожиданно у меня появляется () на входе в takeWhile:

    • Couldn't match type ‘Element mono’ with ‘()’
      Expected type: () -> Bool
        Actual type: Element mono -> Bool
    • In the first argument of ‘CC.takeWhile’, namely ‘pred’
      In the first argument of ‘(.|)’, namely ‘(CC.takeWhile pred)’
      In the first argument of ‘(&)’, namely
        ‘(CC.takeWhile pred) .| sinkList’
    • Relevant bindings include
        pred :: Element mono -> Bool
          (bound at src/FDS/Data/Conduits.hs:148:12)
        goIter :: (Element mono -> Bool) -> m [Element mono]
          (bound at src/FDS/Data/Conduits.hs:148:5)
        preds :: [Element mono -> Bool]
          (bound at src/FDS/Data/Conduits.hs:144:18)
        takeWhileGrouped :: [Element mono -> Bool]
                            -> ConduitT (Element mono) [Element mono] m ()
          (bound at src/FDS/Data/Conduits.hs:144:1)
    |
148 |     goIter pred = (CC.takeWhile pred) .| sinkList & runConduitRes
    |                                 ^^^^

Обновление 4

После исправления еще нескольких ошибок логики и типов, чему действительно помогло добавление внутренней аннотации типа (CC.takeWhile curPred :: ConduitT (Element mono) (Element mono) m ()), у меня есть кое-что, что компилируется, но все еще нуждается в тестировании:

takeWhileGrouped :: forall m mono. (Monad m, MonoFoldable mono) =>
  ([Element mono -> Bool])
  -> ConduitT () (Element mono) m ()
  -> ConduitT (Element mono) [Element mono] m ()
takeWhileGrouped preds conIn = go preds
  where
    go (curPred:nextPreds) = yieldM (goIter curPred) >> go nextPreds
    go [] = yield []
    goIter :: (Element mono -> Bool) -> m ([Element mono])
    goIter curPred = conIn .| CC.takeWhile curPred .| sinkList & runConduit

person bbarker    schedule 25.09.2019    source источник
comment
Я все еще хотел бы знать, как реализовать это, используя await   -  person bbarker    schedule 26.09.2019


Ответы (1)


В конечном итоге я пришел к выводу, что если я хочу реализовать этот компонент, У меня не получилось по компонентному составу (фьюжн).

Вот реализация, которая, кажется, работает:

takeWhileGrouped :: forall m mono. Monad m =>
  [Element mono -> Bool] -> ConduitT (Element mono) [Element mono] m ()
takeWhileGrouped preds = start
  where
    start = await >>= maybe (return ()) (loop preds [])
    loop :: [(Element mono) -> Bool] -> [Element mono] -> (Element mono)
      -> ConduitT (Element mono) [Element mono] m ()
    loop [] _ _ = yield []
    loop curPreds@(predF:predRest) accum x =
        await >>= maybe (yield accumX) go
      where
        accumX = if predF x then x:accum else accum
        go y = if predF y then loop curPreds accumX y
               else yield accumX >> loop predRest [] y

На этот дизайн повлияла наиболее похожая функция, о которой я знал (хотя и из устаревшей библиотеки), groupBy.

person bbarker    schedule 26.09.2019