Internal.hs

{-|
Module      : Pipes.KeyValueCsv.Cell
Copyright   : (c) Marcin Mrotek, 2015
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com
Stability   : experimental

Helper functions

-}

{-# LANGUAGE RankNTypes #-}

module Pipes.KeyValueCsv.Internal where

import Pipes.KeyValueCsv.Internal.Types

import Control.Lens
import Control.Monad.State.Strict
import Data.Char
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder
import Pipes
import qualified Pipes.Prelude as Pipes
import Pipes.Group (FreeT(..), FreeF(..))
import Pipes.Parse (Parser)
import qualified Pipes.Parse as Parse
import qualified Pipes.Text as PipesText

build :: Monad m => Parser Text m Lazy.Text
-- ^Build a lazy 'Text' from chunks obtained from a pipe.
build = 
  Parse.foldAll 
    (\b t -> b <> fromText t) 
    mempty 
    toLazyText

skipSpace :: Monad m => Parser Text m ()
skipSpace = zoom (PipesText.span isSpace) Parse.skipAll

drawText :: Monad m => Parser Text m Lazy.Text
{-^ 
Draw text that may be enclosed in quotes. 
Skips initial whitespace.
If the first non-white character is not a quote mark, the function draws only the part of the text upto the next white character.
-}
drawText = do
  skipSpace
  quote'm <- PipesText.peekChar
  case quote'm of
    Just '"' -> do
      drawn <- Parse.draw *> zoom (PipesText.break isQuote) build
      pure drawn
    Just  _  -> zoom (PipesText.break isSpace) build
    Nothing  -> pure $ Lazy.empty
 where
  isQuote = (== '"')

breakLines'
  :: Monad m
  => (Text -> Bool)
  -> FreeT (Line m) m r
  -> FreeT (Line m) m (FreeT (Line m) m r)
{-^ 
Break a 'FreeT'-delimited stream of lines into two parts, on a line that satisfies the given predicate.
All input lines up to the breaking one will be fully read, and each (not including the breaking one) will be re-'yield'ed.
-}
breakLines' predicate ls = FreeT $ do
  ft <- runFreeT ls
  case ft of
    p@(Pure _) -> pure . Pure . FreeT $ pure p
    Free (Line line) -> do
      (text, leftovers) <- runStateT (Lazy.toStrict <$> build) line
      r <- runEffect $ leftovers >-> Pipes.drain
      pure $ if predicate text
        then Pure r
        else Free . Line $ do 
          yield text 
          pure $ breakLines' predicate r