{-# 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
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | 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
csvQuoteChar :: !(Maybe Char)
  } deriving (ReadPrec [CSVSettings]
ReadPrec CSVSettings
Int -> ReadS CSVSettings
ReadS [CSVSettings]
(Int -> ReadS CSVSettings)
-> ReadS [CSVSettings]
-> ReadPrec CSVSettings
-> ReadPrec [CSVSettings]
-> Read CSVSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CSVSettings]
$creadListPrec :: ReadPrec [CSVSettings]
readPrec :: ReadPrec CSVSettings
$creadPrec :: ReadPrec CSVSettings
readList :: ReadS [CSVSettings]
$creadList :: ReadS [CSVSettings]
readsPrec :: Int -> ReadS CSVSettings
$creadsPrec :: Int -> ReadS CSVSettings
Read, 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
showList :: [CSVSettings] -> ShowS
$cshowList :: [CSVSettings] -> ShowS
show :: CSVSettings -> String
$cshow :: CSVSettings -> String
showsPrec :: Int -> CSVSettings -> ShowS
$cshowsPrec :: Int -> CSVSettings -> ShowS
Show, CSVSettings -> CSVSettings -> Bool
(CSVSettings -> CSVSettings -> Bool)
-> (CSVSettings -> CSVSettings -> Bool) -> Eq CSVSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSVSettings -> CSVSettings -> Bool
$c/= :: CSVSettings -> CSVSettings -> Bool
== :: CSVSettings -> CSVSettings -> Bool
$c== :: CSVSettings -> CSVSettings -> Bool
Eq)



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


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