{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.CSV.Conduit.Types where

-------------------------------------------------------------------------------
import           Data.Default
import qualified Data.Map         as M
import qualified Data.Map.Ordered as MO
-------------------------------------------------------------------------------

data QuoteEmpty = DoQuoteEmpty | DontQuoteEmpty deriving (Int -> QuoteEmpty -> ShowS
[QuoteEmpty] -> ShowS
QuoteEmpty -> String
(Int -> QuoteEmpty -> ShowS)
-> (QuoteEmpty -> String)
-> ([QuoteEmpty] -> ShowS)
-> Show QuoteEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuoteEmpty -> ShowS
showsPrec :: Int -> QuoteEmpty -> ShowS
$cshow :: QuoteEmpty -> String
show :: QuoteEmpty -> String
$cshowList :: [QuoteEmpty] -> ShowS
showList :: [QuoteEmpty] -> ShowS
Show, QuoteEmpty -> QuoteEmpty -> Bool
(QuoteEmpty -> QuoteEmpty -> Bool)
-> (QuoteEmpty -> QuoteEmpty -> Bool) -> Eq QuoteEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuoteEmpty -> QuoteEmpty -> Bool
== :: QuoteEmpty -> QuoteEmpty -> Bool
$c/= :: QuoteEmpty -> QuoteEmpty -> Bool
/= :: QuoteEmpty -> QuoteEmpty -> Bool
Eq)

-------------------------------------------------------------------------------
-- | Settings for a CSV file. This library is intended to be flexible
-- and offer a way to process the majority of text data files out
-- there.
data CSVSettings = CSVSettings
  {
    -- | Separator character to be used in between fields
    CSVSettings -> Char
csvSep       :: !Char

    -- | Quote character that may sometimes be present around fields.
    -- If 'Nothing' is given, the library will never expect quotation
    -- even if it is present.
  , CSVSettings -> Maybe (Char, QuoteEmpty)
csvQuoteCharAndStyle :: !(Maybe (Char, QuoteEmpty))
  } deriving (Int -> CSVSettings -> ShowS
[CSVSettings] -> ShowS
CSVSettings -> String
(Int -> CSVSettings -> ShowS)
-> (CSVSettings -> String)
-> ([CSVSettings] -> ShowS)
-> Show CSVSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSVSettings -> ShowS
showsPrec :: Int -> CSVSettings -> ShowS
$cshow :: CSVSettings -> String
show :: CSVSettings -> String
$cshowList :: [CSVSettings] -> ShowS
showList :: [CSVSettings] -> ShowS
Show, CSVSettings -> CSVSettings -> Bool
(CSVSettings -> CSVSettings -> Bool)
-> (CSVSettings -> CSVSettings -> Bool) -> Eq CSVSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSVSettings -> CSVSettings -> Bool
== :: CSVSettings -> CSVSettings -> Bool
$c/= :: CSVSettings -> CSVSettings -> Bool
/= :: CSVSettings -> CSVSettings -> Bool
Eq)


csvQuoteChar :: CSVSettings -> Maybe Char
csvQuoteChar :: CSVSettings -> Maybe Char
csvQuoteChar = ((Char, QuoteEmpty) -> Char
forall a b. (a, b) -> a
fst ((Char, QuoteEmpty) -> Char)
-> Maybe (Char, QuoteEmpty) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Char, QuoteEmpty) -> Maybe Char)
-> (CSVSettings -> Maybe (Char, QuoteEmpty))
-> CSVSettings
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSVSettings -> Maybe (Char, QuoteEmpty)
csvQuoteCharAndStyle

-------------------------------------------------------------------------------
-- | Default settings for a CSV file.
--
-- > csvSep = ','
-- > csvQuoteChar = Just '"'
--
defCSVSettings :: CSVSettings
defCSVSettings :: CSVSettings
defCSVSettings = CSVSettings
  { csvSep :: Char
csvSep = Char
','
  , csvQuoteCharAndStyle :: Maybe (Char, QuoteEmpty)
csvQuoteCharAndStyle = (Char, QuoteEmpty) -> Maybe (Char, QuoteEmpty)
forall a. a -> Maybe a
Just (Char
'"', QuoteEmpty
DoQuoteEmpty)
  }

defDontQuoteEmptyCSVSettings :: CSVSettings
defDontQuoteEmptyCSVSettings :: CSVSettings
defDontQuoteEmptyCSVSettings = CSVSettings
  { csvSep :: Char
csvSep = Char
','
  , csvQuoteCharAndStyle :: Maybe (Char, QuoteEmpty)
csvQuoteCharAndStyle = (Char, QuoteEmpty) -> Maybe (Char, QuoteEmpty)
forall a. a -> Maybe a
Just (Char
'"', QuoteEmpty
DontQuoteEmpty)
  }

instance Default CSVSettings where
    def :: CSVSettings
def = CSVSettings
defCSVSettings

-------------------------------------------------------------------------------
-- | A 'Row' is just a list of fields
type Row a = [a]

-------------------------------------------------------------------------------
-- | A 'MapRow' is a dictionary based on 'Data.Map' where column names
-- are keys and row's individual cell values are the values of the
-- 'Map'.
type MapRow a = M.Map a a

-- | An 'OrderedMapRow' is a dictionary based on 'Data.Map.Ordered' where column
-- names are keys and row's individual cell values are the values of the 'OMap'.
-- Unlike 'MapRow', 'OrderedMapRow' preserves the insertion ordering of columns.
-- 'OrderedMapRow' is a reasonable default in most cases.
type OrderedMapRow a = MO.OMap a a