{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.Csv.Tutorial
(
Item (..)
, TState (..)
, 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
data Item = Item
{ Item -> String
title :: String
, Item -> TState
state :: TState
, Item -> Maybe Double
time :: Maybe Double
} 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
]
data TState = Todo
| Done
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"
onlyTodo :: Handle
-> Handle
-> IO ()
onlyTodo :: Handle -> Handle -> IO ()
onlyTodo Handle
inH Handle
outH = do
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)
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"])
InputStream Item -> OutputStream Item -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream Item
input OutputStream Item
output
markDone :: String
-> Handle
-> Handle
-> IO ()
markDone :: String -> Handle -> Handle -> IO ()
markDone String
titleOfItem Handle
inH Handle
outH = do
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
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'
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"])
InputStream Item -> OutputStream Item -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream Item
input OutputStream Item
output