{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the Haskell package cassava-streams. It is
subject to the license terms in the LICENSE file found in the
top-level directory of this distribution and at
git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams
package, including this file, may be copied, modified, propagated, or
distributed except according to the terms contained in the LICENSE
file.

-}

--------------------------------------------------------------------------------
-- | A simple tutorial on using the cassava-streams library to glue
-- together cassava and io-streams.
--
-- Note: if you're reading this on Hackage or in Haddock then you
-- should switch to source view with the \"Source\" link at the top of
-- this page or open this file in your favorite text editor.
module System.IO.Streams.Csv.Tutorial
       ( -- * Types representing to-do items and their state
         Item (..)
       , TState (..)

         -- * Functions which use cassava-streams functions
       , onlyTodo
       , markDone
       ) where

--------------------------------------------------------------------------------
import Control.Monad
import Data.Csv
import qualified Data.Vector as V
import System.IO
import qualified System.IO.Streams as Streams
import System.IO.Streams.Csv

--------------------------------------------------------------------------------
-- | A to-do item.
data Item = Item
  { Item -> String
title :: String       -- ^ Title.
  , Item -> TState
state :: TState       -- ^ State.
  , Item -> Maybe Double
time  :: Maybe Double -- ^ Seconds taken to complete.
  } deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq)

instance FromNamedRecord Item where
  parseNamedRecord :: NamedRecord -> Parser Item
parseNamedRecord NamedRecord
m = String -> TState -> Maybe Double -> Item
Item (String -> TState -> Maybe Double -> Item)
-> Parser String -> Parser (TState -> Maybe Double -> Item)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRecord
m NamedRecord -> ByteString -> Parser String
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"Title"
                            Parser (TState -> Maybe Double -> Item)
-> Parser TState -> Parser (Maybe Double -> Item)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
m NamedRecord -> ByteString -> Parser TState
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"State"
                            Parser (Maybe Double -> Item)
-> Parser (Maybe Double) -> Parser Item
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
m NamedRecord -> ByteString -> Parser (Maybe Double)
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"Time"

instance ToNamedRecord Item where
  toNamedRecord :: Item -> NamedRecord
toNamedRecord (Item String
t TState
s Maybe Double
tm) =
    [(ByteString, ByteString)] -> NamedRecord
namedRecord [ ByteString
"Title" ByteString -> String -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= String
t
                , ByteString
"State" ByteString -> TState -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= TState
s
                , ByteString
"Time"  ByteString -> Maybe Double -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Maybe Double
tm
                ]

--------------------------------------------------------------------------------
-- | Possible states for a to-do item.
data TState = Todo -- ^ Item needs to be completed.
            | Done -- ^ Item has been finished.
            deriving (Int -> TState -> ShowS
[TState] -> ShowS
TState -> String
(Int -> TState -> ShowS)
-> (TState -> String) -> ([TState] -> ShowS) -> Show TState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TState] -> ShowS
$cshowList :: [TState] -> ShowS
show :: TState -> String
$cshow :: TState -> String
showsPrec :: Int -> TState -> ShowS
$cshowsPrec :: Int -> TState -> ShowS
Show, TState -> TState -> Bool
(TState -> TState -> Bool)
-> (TState -> TState -> Bool) -> Eq TState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TState -> TState -> Bool
$c/= :: TState -> TState -> Bool
== :: TState -> TState -> Bool
$c== :: TState -> TState -> Bool
Eq)

instance FromField TState where
  parseField :: ByteString -> Parser TState
parseField ByteString
"TODO" = TState -> Parser TState
forall (m :: * -> *) a. Monad m => a -> m a
return TState
Todo
  parseField ByteString
"DONE" = TState -> Parser TState
forall (m :: * -> *) a. Monad m => a -> m a
return TState
Done
  parseField ByteString
_      = Parser TState
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToField TState where
  toField :: TState -> ByteString
toField TState
Todo = ByteString
"TODO"
  toField TState
Done = ByteString
"DONE"

--------------------------------------------------------------------------------
-- | The @onlyTodo@ function reads to-do 'Item's from the given input
-- handle (in CSV format) and writes them back to the output handle
-- (also in CSV format), but only if the items are in the @Todo@
-- state.  In another words, the CSV data is filtered so that the
-- output handle only receives to-do 'Item's which haven't been
-- completed.
--
-- The io-streams @handleToInputStream@ function is used to create an
-- @InputStream ByteString@ stream from the given input handle.
--
-- That stream is then given to the cassava-streams function
-- 'decodeStreamByName' which converts the @InputStream ByteString@
-- stream into an @InputStream Item@ stream.
--
-- Notice that the cassava-streams function 'onlyValidRecords' is used
-- to transform the decoding stream into one that only produces valid
-- records.  Any records which fail type conversion (via
-- @FromNamedRecord@ or @FromRecord@) will not escape from
-- 'onlyValidRecords' but instead will throw an exception.
--
-- Finally the io-streams @filter@ function is used to filter the
-- input stream so that it only produces to-do items which haven't
-- been completed.
onlyTodo :: Handle -- ^ Input handle where CSV data can be read.
         -> Handle -- ^ Output handle where CSV data can be written.
         -> IO ()
onlyTodo :: Handle -> Handle -> IO ()
onlyTodo Handle
inH Handle
outH = do
  -- A stream which produces items which are not 'Done'.
  InputStream Item
input  <- Handle -> IO (InputStream ByteString)
Streams.handleToInputStream Handle
inH         IO (InputStream ByteString)
-> (InputStream ByteString
    -> IO (InputStream (Either String Item)))
-> IO (InputStream (Either String Item))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            InputStream ByteString -> IO (InputStream (Either String Item))
forall a.
FromNamedRecord a =>
InputStream ByteString -> IO (InputStream (Either String a))
decodeStreamByName IO (InputStream (Either String Item))
-> (InputStream (Either String Item) -> IO (InputStream Item))
-> IO (InputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream (Either String Item) -> IO (InputStream Item)
forall a. InputStream (Either String a) -> IO (InputStream a)
onlyValidRecords IO (InputStream Item)
-> (InputStream Item -> IO (InputStream Item))
-> IO (InputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (Item -> Bool) -> InputStream Item -> IO (InputStream Item)
forall a. (a -> Bool) -> InputStream a -> IO (InputStream a)
Streams.filter (\Item
item -> Item -> TState
state Item
item TState -> TState -> Bool
forall a. Eq a => a -> a -> Bool
/= TState
Done)

  -- A stream to write items into.  They will be converted to CSV.
  OutputStream Item
output <- Handle -> IO (OutputStream ByteString)
Streams.handleToOutputStream Handle
outH IO (OutputStream ByteString)
-> (OutputStream ByteString -> IO (OutputStream Item))
-> IO (OutputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            Header -> OutputStream ByteString -> IO (OutputStream Item)
forall a.
ToNamedRecord a =>
Header -> OutputStream ByteString -> IO (OutputStream a)
encodeStreamByName ([ByteString] -> Header
forall a. [a] -> Vector a
V.fromList [ByteString
"State", ByteString
"Time", ByteString
"Title"])

  -- Connect the input and output streams.
  InputStream Item -> OutputStream Item -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream Item
input OutputStream Item
output

--------------------------------------------------------------------------------
-- | The @markDone@ function will read to-do items from the given
-- input handle and mark any matching items as @Done@.  All to-do
-- items are written to the given output handle.
markDone :: String -- ^ Items with this title are marked as @Done@.
         -> Handle -- ^ Input handle where CSV data can be read.
         -> Handle -- ^ Output handle where CSV data can be written.
         -> IO ()
markDone :: String -> Handle -> Handle -> IO ()
markDone String
titleOfItem Handle
inH Handle
outH = do
  -- Change matching items to the 'Done' state.
  let markDone' :: Item -> Item
markDone' Item
item = if Item -> String
title Item
item String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
titleOfItem
                         then Item
item {state :: TState
state = TState
Done}
                         else Item
item

  -- A stream which produces items and converts matching items to the
  -- 'Done' state.
  InputStream Item
input  <- Handle -> IO (InputStream ByteString)
Streams.handleToInputStream Handle
inH         IO (InputStream ByteString)
-> (InputStream ByteString
    -> IO (InputStream (Either String Item)))
-> IO (InputStream (Either String Item))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            InputStream ByteString -> IO (InputStream (Either String Item))
forall a.
FromNamedRecord a =>
InputStream ByteString -> IO (InputStream (Either String a))
decodeStreamByName IO (InputStream (Either String Item))
-> (InputStream (Either String Item) -> IO (InputStream Item))
-> IO (InputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream (Either String Item) -> IO (InputStream Item)
forall a. InputStream (Either String a) -> IO (InputStream a)
onlyValidRecords IO (InputStream Item)
-> (InputStream Item -> IO (InputStream Item))
-> IO (InputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            (Item -> Item) -> InputStream Item -> IO (InputStream Item)
forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map Item -> Item
markDone'

  -- A stream to write items into.  They will be converted to CSV.
  OutputStream Item
output <- Handle -> IO (OutputStream ByteString)
Streams.handleToOutputStream Handle
outH IO (OutputStream ByteString)
-> (OutputStream ByteString -> IO (OutputStream Item))
-> IO (OutputStream Item)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            Header -> OutputStream ByteString -> IO (OutputStream Item)
forall a.
ToNamedRecord a =>
Header -> OutputStream ByteString -> IO (OutputStream a)
encodeStreamByName ([ByteString] -> Header
forall a. [a] -> Vector a
V.fromList [ByteString
"State", ByteString
"Time", ByteString
"Title"])

  -- Connect the input and output streams.
  InputStream Item -> OutputStream Item -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream Item
input OutputStream Item
output