{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DSV.FileFold
  ( foldDsvFileWithoutHeader, foldDsvFileWithoutHeaderM
  , foldDsvFileIgnoringHeader, foldDsvFileIgnoringHeaderM
  , foldDsvFileWithZippedHeader, foldDsvFileWithZippedHeaderM
  ) where

import DSV.ByteString
import DSV.DelimiterType
import DSV.Fold
import DSV.Header
import DSV.IO
import DSV.ParseStop
import DSV.Parsing
import DSV.Pipes
import DSV.Prelude
import DSV.Vector

-- pipes-safe
import qualified Pipes.Safe.Prelude as P

foldDsvFileWithoutHeader ::
    forall m result .
    MonadIO m
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> Fold (Vector ByteString) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileWithoutHeader :: Delimiter
-> FilePath
-> Fold (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileWithoutHeader Delimiter
d FilePath
fp Fold (Vector ByteString) result
fld =
    IO (ParseStop, result) -> m (ParseStop, result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ParseStop, result) -> m (ParseStop, result))
-> IO (ParseStop, result) -> m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ SafeT IO (ParseStop, result) -> IO (ParseStop, result)
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT IO (ParseStop, result) -> IO (ParseStop, result))
-> SafeT IO (ParseStop, result) -> IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ FilePath
-> IOMode
-> (Handle -> SafeT IO (ParseStop, result))
-> SafeT IO (ParseStop, result)
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
P.withFile FilePath
fp IOMode
ReadMode ((Handle -> SafeT IO (ParseStop, result))
 -> SafeT IO (ParseStop, result))
-> (Handle -> SafeT IO (ParseStop, result))
-> SafeT IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> IO (ParseStop, result) -> SafeT IO (ParseStop, result)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (ParseStop, result) -> SafeT IO (ParseStop, result))
-> IO (ParseStop, result) -> SafeT IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$
        Fold (Vector ByteString) result
-> Producer (Vector ByteString) IO ParseStop
-> IO (ParseStop, result)
forall a b (m :: * -> *) r.
Monad m =>
Fold a b -> Producer a m r -> m (r, b)
foldProducer Fold (Vector ByteString) result
fld (Delimiter -> Handle -> Producer (Vector ByteString) IO ParseStop
forall (m :: * -> *).
MonadIO m =>
Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
handleDsvRowProducer Delimiter
d Handle
h)

foldDsvFileWithoutHeaderM ::
    forall m result .
    (MonadCatch m, MonadMask m, MonadIO m)
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> FoldM m (Vector ByteString) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileWithoutHeaderM :: Delimiter
-> FilePath
-> FoldM m (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileWithoutHeaderM Delimiter
d FilePath
fp FoldM m (Vector ByteString) result
fld =
    SafeT m (ParseStop, result) -> m (ParseStop, result)
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT m (ParseStop, result) -> m (ParseStop, result))
-> SafeT m (ParseStop, result) -> m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ FilePath
-> IOMode
-> (Handle -> SafeT m (ParseStop, result))
-> SafeT m (ParseStop, result)
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
P.withFile FilePath
fp IOMode
ReadMode ((Handle -> SafeT m (ParseStop, result))
 -> SafeT m (ParseStop, result))
-> (Handle -> SafeT m (ParseStop, result))
-> SafeT m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> m (ParseStop, result) -> SafeT m (ParseStop, result)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ParseStop, result) -> SafeT m (ParseStop, result))
-> m (ParseStop, result) -> SafeT m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$
        FoldM m (Vector ByteString) result
-> Producer (Vector ByteString) m ParseStop
-> m (ParseStop, result)
forall a b (m :: * -> *) r.
Monad m =>
FoldM m a b -> Producer a m r -> m (r, b)
foldProducerM FoldM m (Vector ByteString) result
fld (Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
forall (m :: * -> *).
MonadIO m =>
Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
handleDsvRowProducer Delimiter
d Handle
h)

foldDsvFileIgnoringHeader ::
    forall m result .
    MonadIO m
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> Fold (Vector ByteString) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileIgnoringHeader :: Delimiter
-> FilePath
-> Fold (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileIgnoringHeader Delimiter
d FilePath
fp Fold (Vector ByteString) result
fld =
    Delimiter
-> FilePath
-> Fold (Vector ByteString) result
-> m (ParseStop, result)
forall (m :: * -> *) result.
MonadIO m =>
Delimiter
-> FilePath
-> Fold (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileWithoutHeader Delimiter
d FilePath
fp (Natural
-> Fold (Vector ByteString) result
-> Fold (Vector ByteString) result
forall a b. Natural -> Fold a b -> Fold a b
foldDrop Natural
1 Fold (Vector ByteString) result
fld)

foldDsvFileIgnoringHeaderM ::
    forall m result .
    (MonadCatch m, MonadMask m, MonadIO m)
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> FoldM m (Vector ByteString) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileIgnoringHeaderM :: Delimiter
-> FilePath
-> FoldM m (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileIgnoringHeaderM Delimiter
d FilePath
fp FoldM m (Vector ByteString) result
fld =
    Delimiter
-> FilePath
-> FoldM m (Vector ByteString) result
-> m (ParseStop, result)
forall (m :: * -> *) result.
(MonadCatch m, MonadMask m, MonadIO m) =>
Delimiter
-> FilePath
-> FoldM m (Vector ByteString) result
-> m (ParseStop, result)
foldDsvFileWithoutHeaderM Delimiter
d FilePath
fp (Natural
-> FoldM m (Vector ByteString) result
-> FoldM m (Vector ByteString) result
forall (m :: * -> *) a b.
Monad m =>
Natural -> FoldM m a b -> FoldM m a b
foldDropM Natural
1 FoldM m (Vector ByteString) result
fld)

foldDsvFileWithZippedHeader ::
    forall m result .
    MonadIO m
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> Fold (Vector (ByteString, ByteString)) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileWithZippedHeader :: Delimiter
-> FilePath
-> Fold (Vector (ByteString, ByteString)) result
-> m (ParseStop, result)
foldDsvFileWithZippedHeader Delimiter
d FilePath
fp Fold (Vector (ByteString, ByteString)) result
fld =
    IO (ParseStop, result) -> m (ParseStop, result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ParseStop, result) -> m (ParseStop, result))
-> IO (ParseStop, result) -> m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ SafeT IO (ParseStop, result) -> IO (ParseStop, result)
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT IO (ParseStop, result) -> IO (ParseStop, result))
-> SafeT IO (ParseStop, result) -> IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ FilePath
-> IOMode
-> (Handle -> SafeT IO (ParseStop, result))
-> SafeT IO (ParseStop, result)
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
P.withFile FilePath
fp IOMode
ReadMode ((Handle -> SafeT IO (ParseStop, result))
 -> SafeT IO (ParseStop, result))
-> (Handle -> SafeT IO (ParseStop, result))
-> SafeT IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> IO (ParseStop, result) -> SafeT IO (ParseStop, result)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (ParseStop, result) -> SafeT IO (ParseStop, result))
-> IO (ParseStop, result) -> SafeT IO (ParseStop, result)
forall a b. (a -> b) -> a -> b
$
        Fold (Vector (ByteString, ByteString)) result
-> Producer (Vector (ByteString, ByteString)) IO ParseStop
-> IO (ParseStop, result)
forall a b (m :: * -> *) r.
Monad m =>
Fold a b -> Producer a m r -> m (r, b)
foldProducer Fold (Vector (ByteString, ByteString)) result
fld (Delimiter -> Handle -> Producer (Vector ByteString) IO ParseStop
forall (m :: * -> *).
MonadIO m =>
Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
handleDsvRowProducer Delimiter
d Handle
h Producer (Vector ByteString) IO ParseStop
-> Proxy
     ()
     (Vector ByteString)
     ()
     (Vector (ByteString, ByteString))
     IO
     ParseStop
-> Producer (Vector (ByteString, ByteString)) IO ParseStop
forall (m :: * -> *) a' a b r c' c.
Monad m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy
  ()
  (Vector ByteString)
  ()
  (Vector (ByteString, ByteString))
  IO
  ParseStop
forall a (m :: * -> *) r.
Monad m =>
Pipe (Vector a) (Vector (a, a)) m r
zipHeaderPipe)

foldDsvFileWithZippedHeaderM ::
    forall m result .
    (MonadCatch m, MonadMask m, MonadIO m)
    => Delimiter
        -- ^ What character separates input values, e.g. 'comma' or 'tab'
    -> FilePath
        -- ^ The path of a DSV file to read
    -> FoldM m (Vector (ByteString, ByteString)) result
        -- ^ What to do with each row
    -> m (ParseStop, result)

foldDsvFileWithZippedHeaderM :: Delimiter
-> FilePath
-> FoldM m (Vector (ByteString, ByteString)) result
-> m (ParseStop, result)
foldDsvFileWithZippedHeaderM Delimiter
d FilePath
fp FoldM m (Vector (ByteString, ByteString)) result
fld =
    SafeT m (ParseStop, result) -> m (ParseStop, result)
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT m (ParseStop, result) -> m (ParseStop, result))
-> SafeT m (ParseStop, result) -> m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ FilePath
-> IOMode
-> (Handle -> SafeT m (ParseStop, result))
-> SafeT m (ParseStop, result)
forall (m :: * -> *) r.
MonadSafe m =>
FilePath -> IOMode -> (Handle -> m r) -> m r
P.withFile FilePath
fp IOMode
ReadMode ((Handle -> SafeT m (ParseStop, result))
 -> SafeT m (ParseStop, result))
-> (Handle -> SafeT m (ParseStop, result))
-> SafeT m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> m (ParseStop, result) -> SafeT m (ParseStop, result)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ParseStop, result) -> SafeT m (ParseStop, result))
-> m (ParseStop, result) -> SafeT m (ParseStop, result)
forall a b. (a -> b) -> a -> b
$
        FoldM m (Vector (ByteString, ByteString)) result
-> Producer (Vector (ByteString, ByteString)) m ParseStop
-> m (ParseStop, result)
forall a b (m :: * -> *) r.
Monad m =>
FoldM m a b -> Producer a m r -> m (r, b)
foldProducerM FoldM m (Vector (ByteString, ByteString)) result
fld (Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
forall (m :: * -> *).
MonadIO m =>
Delimiter -> Handle -> Producer (Vector ByteString) m ParseStop
handleDsvRowProducer Delimiter
d Handle
h Producer (Vector ByteString) m ParseStop
-> Proxy
     ()
     (Vector ByteString)
     ()
     (Vector (ByteString, ByteString))
     m
     ParseStop
-> Producer (Vector (ByteString, ByteString)) m ParseStop
forall (m :: * -> *) a' a b r c' c.
Monad m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy
  ()
  (Vector ByteString)
  ()
  (Vector (ByteString, ByteString))
  m
  ParseStop
forall a (m :: * -> *) r.
Monad m =>
Pipe (Vector a) (Vector (a, a)) m r
zipHeaderPipe)