Как исправить этот код Conduit, вызывая появление типа списка, где я не ожидаю такого? - PullRequest
Новая
       16

Как исправить этот код Conduit, вызывая появление типа списка, где я не ожидаю такого?

0 голосов
/ 25 января 2019

Я некоторое время боролся с этим кодексом Conduit, любая помощь будет чрезвычайно признательна.Это похоже на то, что этот код развивался в результате случайной мутации, в то время как средство проверки типов обеспечивает естественный отбор.Вот один из наиболее подходящих кандидатов, которые у меня есть на данный момент: 

import           Conduit
import qualified Data.Conduit.Combinators       as DCC
import           Data.CSV.Conduit
import           Data.Function                  ((&))
import           Data.List.Split                (splitOn)
import           Data.Map                       as DM
import           Data.Text                      (Text)
import qualified Data.Text                      as Txt
import qualified Data.Text.IO                   as DTIO
import           Data.Vector                    (Vector)
import qualified Data.Vector                    as DV
import           Path
import           System.FilePath.Posix

retrieveSmaXtec :: Path Abs Dir -> IO (Vector (MapRow Text))
retrieveSmaXtec sxDir = do
  files <- sourceDirectoryDeep False (fromAbsDir sxDir) & return
  fileVector <- return $ runConduit $ files .| sinkVector
  csvRowsByFile <- runConduit ((yieldM fileVector) .| DCC.mapM processCSV .| sinkVector)
  fNameRows <- readFnameData $ yieldM fileVector
  (pairFill fNameRows csvRowsByFile)
    & fmap (uncurry DM.union)
    & return
  where
    fileList :: Path Abs Dir -> IO (Vector FilePath)
    fileList dir = sourceDirectoryDeep False (fromAbsDir sxDir) .| sinkVector & runConduit

    expandZip :: MapRow Text -> Vector (MapRow Text) -> Vector (MapRow Text, MapRow Text)
    expandZip one many = zip (replicate mlen one) many
      where
        mlen = length many

    pairFill :: Vector (MapRow Text) -> Vector (Vector (MapRow Text)) -> Vector (MapRow Text, MapRow Text)
    pairFill ones manies = join $ fmap (uncurry expandZip) (zip ones manies)

    processCSV :: FilePath -> IO (Vector (MapRow Text))
    processCSV fp = sourceFile fp
      .| intoCSV defCSVSettings
      .| sinkVector
      & runConduitRes
    readFnameData :: (MonadThrow m, MonadResource m, PrimMonad m) => ConduitT () FilePath m () -> m (Vector (MapRow Text))
    readFnameData files = runConduit $ files .| processFileName .| sinkVector

    processFileName :: (MonadResource m, MonadThrow m, PrimMonad m) =>
      ConduitT FilePath (MapRow Text) m ()
    processFileName = mapC go
      where
        go :: FilePath -> MapRow Text
        go fp = takeFileName fp
          & takeWhile (/= '.')
          & splitOn "_"
          & fmap Txt.pack
          & zip colNames
          & DM.fromList
        colNames = [markKey, idKey]

Текущий момент путаницы, который возникает в обеих ошибках ниже, заключается в том, что [FilePath] выскакивает, когда я ожидаю, что все будет просто FilePath.Теперь, даже если это будет исправлено, я не сомневаюсь, что могут появиться другие ошибки, поэтому, если есть решение для этого, требующее небольшой переделки, я был бы рад попробовать. 

    * Couldn't match type `Char' with `[Char]'
      Expected type: ConduitM
                       [FilePath] Void IO (Vector (Vector (MapRow Text)))
        Actual type: ConduitM
                       FilePath Void IO (Vector (Vector (MapRow Text)))
    * In the second argument of `(.|)', namely
        `DCC.mapM processCSV .| sinkVector'
      In the first argument of `runConduit', namely
        `((yieldM fileVector) .| DCC.mapM processCSV .| sinkVector)'
      In a stmt of a 'do' block:
        csvRowsByFile <- runConduit
                           ((yieldM fileVector) .| DCC.mapM processCSV .| sinkVector)
   |
40 |   csvRowsByFile <- runConduit ((yieldM fileVector) .| DCC.mapM processCSV .| sinkVector)
   |                                                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

    * Couldn't match type `[Char]' with `Char'
      Expected type: ConduitT () FilePath IO ()
        Actual type: ConduitT () [FilePath] IO ()
    * In the second argument of `($)', namely `yieldM fileVector'
      In a stmt of a 'do' block:
        fNameRows <- readFnameData $ yieldM fileVector
      In the expression:
        do files <- sourceDirectoryDeep False (fromAbsDir sxDir) & return
           fileVector <- return $ runConduit $ files .| sinkVector
           csvRowsByFile <- runConduit
                              ((yieldM fileVector) .| DCC.mapM processCSV .| sinkVector)
           fNameRows <- readFnameData $ yieldM fileVector
           ....
   |
41 |   fNameRows <- readFnameData $ yieldM fileVector
   |                                ^^^^^^^^^^^^^^^^^

Этот вопрос начался в альтернативной форме на Как объединить входные отношения один-к-одному и один-ко-многим: выходные отношения в канале? , но сейчас я просто пытаюсь получить егоработа, как-то , так или иначе .

1 Ответ

0 голосов
/ 25 января 2019

Я придумала решение, поспав немного и потратив на него больше времени.Я до сих пор не понимаю, почему некоторые вещи, которые я пробовал, не работали, но я вполне доволен конечным результатом (если не тем путем, который я выбрал, но обучение - это боль , вхотя бы иногда).Основное различие заключается в том, что я решил повторно использовать канал sourceDirectoryDeep (сейчас files) вместо того, чтобы пытаться превратить его в вектор напрямую.Я также должен был быть немного более умным с тем, как я написал processCSV, что включало один ложный поворот, который все еще смущает меня ( Почему иногда можно получить "Нет экземпляра для текстового текста CSV, возникающего из-за использования` intoCSV "`" при использовании CSV-проводника? ). 

retrieveSmaXtec :: Path Abs Dir -> IO (Vector SxRecord)
retrieveSmaXtec sxDir = do
  csvRows <- getCsvRows
  fnameRows <- getFileNameRows
  rows <- return $ pairFill fnameRows csvRows & fmap (uncurry DM.union)
  print rows
  rows & fmap fromRow & catMaybes & return
  where
    getCsvRows :: IO (Vector (Vector (MapRow Text)))
    getCsvRows = files .| processCSV & runConduitRes

    getFileNameRows :: IO (Vector (MapRow Text))
    getFileNameRows = files .| processFileName & runConduitRes

    files :: MonadResource m => ConduitT () FilePath m ()
    files = sourceDirectoryDeep False (fromAbsDir sxDir)

    expandZip :: MapRow Text -> Vector (MapRow Text) -> Vector (MapRow Text, MapRow Text)
    expandZip one many_ = zip (replicate mlen one) many_
      where
        mlen = length many_

    pairFill :: Vector (MapRow Text) -> Vector (Vector (MapRow Text)) -> Vector (MapRow Text, MapRow Text)
    pairFill ones manies = join $ fmap (uncurry expandZip) (zip ones manies)

    processCSV :: (MonadResource m, MonadThrow m, PrimMonad m) =>
      ConduitT FilePath Void m (Vector (Vector (MapRow Text)))
    processCSV = mapMC (readCSVFile defCSVSettings) .| sinkVector

    processFileName :: (MonadResource m, MonadThrow m, PrimMonad m) =>
      ConduitT FilePath Void m (Vector (MapRow Text))
    processFileName = mapC go
      .| sinkVector
      where
        go :: FilePath -> MapRow Text
        go fp = takeFileName fp
          & takeWhile (/= '.')
          & splitOn "_"
          & fmap Txt.pack
          & zip colNames
          & DM.fromList
        colNames = [markKey, idKey]
...