-- |
-- Module      : Foundation.Format.CSV.Types
-- License     : BSD-style
-- Maintainer  : Foundation
-- Stability   : experimental
-- Portability : portable
--

{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE FlexibleInstances          #-}

module Foundation.Format.CSV.Types
    (-- * CSV
      CSV
    , unCSV

    -- * Row
    , Row
    , unRow
    , Record(..)
    -- * Field
    , Field(..)
    , Escaping(..)
    , IsField(..)
    -- ** helpers
    , integral
    , float
    , string
    ) where

import           Basement.Imports
import           Basement.BoxedArray              (length, unsafeIndex)
import           Basement.NormalForm              (NormalForm(..))
import           Basement.From                    (Into, into)
import           Basement.String                  (any, elem, null, uncons)
import qualified Basement.String       as String (singleton)
import           Basement.Types.Word128           (Word128)
import           Basement.Types.Word256           (Word256)
import           Foundation.Collection.Element    (Element)
import           Foundation.Collection.Collection (Collection, nonEmpty_)
import           Foundation.Collection.Sequential (Sequential)
import           Foundation.Collection.Indexed    (IndexedCollection)
import           Foundation.Check.Arbitrary       (Arbitrary(..), frequency)
import           Foundation.String.Read (readDouble, readInteger)

-- | CSV field
data Field
    = FieldInteger Integer
    | FieldDouble  Double
    | FieldString  String  Escaping
  deriving (Field -> Field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, Typeable)
instance NormalForm Field where
    toNormalForm :: Field -> ()
toNormalForm (FieldInteger Integer
i) = forall a. NormalForm a => a -> ()
toNormalForm Integer
i
    toNormalForm (FieldDouble  Double
d) = forall a. NormalForm a => a -> ()
toNormalForm Double
d
    toNormalForm (FieldString  String
s Escaping
e) = forall a. NormalForm a => a -> ()
toNormalForm String
s seq :: forall a b. a -> b -> b
`seq` forall a. NormalForm a => a -> ()
toNormalForm Escaping
e
instance Arbitrary Field where
    arbitrary :: Gen Field
arbitrary = forall a. NonEmpty [(Word, Gen a)] -> Gen a
frequency forall a b. (a -> b) -> a -> b
$ forall c. Collection c => c -> NonEmpty c
nonEmpty_ [ (Word
1, Integer -> Field
FieldInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
                                      , (Word
1, Double -> Field
FieldDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
                                      , (Word
3, String -> Field
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
                                      ]

data Escaping = NoEscape | Escape | DoubleEscape
  deriving (Escaping -> Escaping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Escaping -> Escaping -> Bool
$c/= :: Escaping -> Escaping -> Bool
== :: Escaping -> Escaping -> Bool
$c== :: Escaping -> Escaping -> Bool
Eq, Eq Escaping
Escaping -> Escaping -> Bool
Escaping -> Escaping -> Ordering
Escaping -> Escaping -> Escaping
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Escaping -> Escaping -> Escaping
$cmin :: Escaping -> Escaping -> Escaping
max :: Escaping -> Escaping -> Escaping
$cmax :: Escaping -> Escaping -> Escaping
>= :: Escaping -> Escaping -> Bool
$c>= :: Escaping -> Escaping -> Bool
> :: Escaping -> Escaping -> Bool
$c> :: Escaping -> Escaping -> Bool
<= :: Escaping -> Escaping -> Bool
$c<= :: Escaping -> Escaping -> Bool
< :: Escaping -> Escaping -> Bool
$c< :: Escaping -> Escaping -> Bool
compare :: Escaping -> Escaping -> Ordering
$ccompare :: Escaping -> Escaping -> Ordering
Ord, Int -> Escaping
Escaping -> Int
Escaping -> [Escaping]
Escaping -> Escaping
Escaping -> Escaping -> [Escaping]
Escaping -> Escaping -> Escaping -> [Escaping]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Escaping -> Escaping -> Escaping -> [Escaping]
$cenumFromThenTo :: Escaping -> Escaping -> Escaping -> [Escaping]
enumFromTo :: Escaping -> Escaping -> [Escaping]
$cenumFromTo :: Escaping -> Escaping -> [Escaping]
enumFromThen :: Escaping -> Escaping -> [Escaping]
$cenumFromThen :: Escaping -> Escaping -> [Escaping]
enumFrom :: Escaping -> [Escaping]
$cenumFrom :: Escaping -> [Escaping]
fromEnum :: Escaping -> Int
$cfromEnum :: Escaping -> Int
toEnum :: Int -> Escaping
$ctoEnum :: Int -> Escaping
pred :: Escaping -> Escaping
$cpred :: Escaping -> Escaping
succ :: Escaping -> Escaping
$csucc :: Escaping -> Escaping
Enum, Escaping
forall a. a -> a -> Bounded a
maxBound :: Escaping
$cmaxBound :: Escaping
minBound :: Escaping
$cminBound :: Escaping
Bounded, Int -> Escaping -> ShowS
[Escaping] -> ShowS
Escaping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Escaping] -> ShowS
$cshowList :: [Escaping] -> ShowS
show :: Escaping -> String
$cshow :: Escaping -> String
showsPrec :: Int -> Escaping -> ShowS
$cshowsPrec :: Int -> Escaping -> ShowS
Show, Typeable)
instance NormalForm Escaping where
    toNormalForm :: Escaping -> ()
toNormalForm !Escaping
_ = ()

class IsField a where
    toField :: a -> Field
    fromField :: Field -> Either String a
instance IsField Field where
    toField :: Field -> Field
toField = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    fromField :: Field -> Either String Field
fromField = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance IsField a => IsField (Maybe a) where
    toField :: Maybe a -> Field
toField Maybe a
Nothing  = String -> Escaping -> Field
FieldString forall a. Monoid a => a
mempty Escaping
NoEscape
    toField (Just a
a) = forall a. IsField a => a -> Field
toField a
a
    fromField :: Field -> Either String (Maybe a)
fromField stuff :: Field
stuff@(FieldString String
p Escaping
NoEscape)
        | String -> Bool
null String
p = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField Field
stuff
    fromField Field
stuff = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField Field
stuff

fromIntegralField :: Integral b => Field -> Either String b
fromIntegralField :: forall b. Integral b => Field -> Either String b
fromIntegralField (FieldString String
str Escaping
NoEscape) = case String -> Maybe Integer
readInteger String
str of
    Maybe Integer
Nothing -> forall a b. a -> Either a b
Left String
"Invalid integral field"
    Just Integer
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Integer -> a
fromInteger Integer
v
fromIntegralField (FieldInteger Integer
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Integral a => Integer -> a
fromInteger Integer
v)
fromIntegralField Field
_ = forall a b. a -> Either a b
Left String
"Expected integral value"

fromDoubleField :: Field -> Either String Double
fromDoubleField :: Field -> Either String Double
fromDoubleField (FieldString String
str Escaping
NoEscape) = case String -> Maybe Double
readDouble String
str of
    Maybe Double
Nothing -> forall a b. a -> Either a b
Left String
"Invalid double field"
    Just Double
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
v
fromDoubleField (FieldDouble Double
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
v
fromDoubleField Field
_ = forall a b. a -> Either a b
Left String
"Expected double value"

instance IsField Bool where
    toField :: Bool -> Field
toField = forall a. IsField a => a -> Field
toField forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show
    fromField :: Field -> Either String Bool
fromField (FieldString String
"True" Escaping
NoEscape) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    fromField (FieldString String
"False" Escaping
NoEscape) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    fromField Field
_ = forall a b. a -> Either a b
Left String
"not a boolean value"
instance IsField Int8 where
    toField :: Int8 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Int8
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int16 where
    toField :: Int16 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Int16
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int32 where
    toField :: Int32 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Int32
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int64 where
    toField :: Int64 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Int64
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int where
    toField :: Int -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Int
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField

instance IsField Word8 where
    toField :: Word8 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word8
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word16 where
    toField :: Word16 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word16
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word32 where
    toField :: Word32 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word32
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word64 where
    toField :: Word64 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word64
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word where
    toField :: Word -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word128 where
    toField :: Word128 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word128
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word256 where
    toField :: Word256 -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Word256
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField

instance IsField Integer where
    toField :: Integer -> Field
toField = Integer -> Field
FieldInteger
    fromField :: Field -> Either String Integer
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Natural where
    toField :: Natural -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String Natural
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField

instance IsField Double where
    toField :: Double -> Field
toField = Double -> Field
FieldDouble
    fromField :: Field -> Either String Double
fromField = Field -> Either String Double
fromDoubleField

instance IsField Char where
    toField :: Char -> Field
toField = String -> Field
string forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> String
String.singleton
    fromField :: Field -> Either String Char
fromField (FieldString String
str Escaping
_) = case String -> Maybe (Char, String)
uncons String
str of
        Just (Char
c, String
str') | String -> Bool
null String
str' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
                       | Bool
otherwise -> forall a b. a -> Either a b
Left String
"Expected a char, but received a String"
        Maybe (Char, String)
Nothing -> forall a b. a -> Either a b
Left String
"Expected a char"
    fromField Field
_ = forall a b. a -> Either a b
Left String
"Expected a char"

instance IsField (Offset a) where
    toField :: Offset a -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String (Offset a)
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField (CountOf a) where
    toField :: CountOf a -> Field
toField = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into
    fromField :: Field -> Either String (CountOf a)
fromField = forall b. Integral b => Field -> Either String b
fromIntegralField

instance IsField [Char] where
    toField :: String -> Field
toField = String -> Field
string forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString
    fromField :: Field -> Either String String
fromField (FieldString String
str Escaping
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. IsList l => l -> [Item l]
toList String
str
    fromField Field
_ = forall a b. a -> Either a b
Left String
"Expected a Lazy String"
instance IsField String where
    toField :: String -> Field
toField = String -> Field
string
    fromField :: Field -> Either String String
fromField (FieldString String
str Escaping
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str
    fromField Field
_ = forall a b. a -> Either a b
Left String
"Expected a UTF8 String"

-- | helper function to create a `FieldInteger`
--
integral :: Into Integer a => a -> Field
integral :: forall a. Into Integer a => a -> Field
integral = Integer -> Field
FieldInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Into b a => a -> b
into

float :: Double -> Field
float :: Double -> Field
float = Double -> Field
FieldDouble

-- | heler function to create a FieldString.
--
-- This function will findout automatically if an escaping is needed.
-- if you wish to perform the escaping manually, do not used this function
--
string :: String -> Field
string :: String -> Field
string String
s = String -> Escaping -> Field
FieldString String
s Escaping
encoding
  where
    encoding :: Escaping
encoding
        | (Char -> Bool) -> String -> Bool
any Char -> Bool
g String
s   = Escaping
DoubleEscape
        | (Char -> Bool) -> String -> Bool
any Char -> Bool
f String
s   = Escaping
Escape
        | Bool
otherwise = Escaping
NoEscape
    g :: Char -> Bool
g Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'\"'
    f :: Char -> Bool
f Char
c = Char
c Char -> String -> Bool
`elem` String
",\r\n"

-- | CSV Row
--
newtype Row = Row { Row -> Array Field
unRow :: Array Field }
  deriving (Row -> Row -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, Typeable, NonEmpty Row -> Row
Row -> Row -> Row
forall b. Integral b => b -> Row -> Row
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Row -> Row
$cstimes :: forall b. Integral b => b -> Row -> Row
sconcat :: NonEmpty Row -> Row
$csconcat :: NonEmpty Row -> Row
<> :: Row -> Row -> Row
$c<> :: Row -> Row -> Row
Semigroup, Semigroup Row
Row
[Row] -> Row
Row -> Row -> Row
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Row] -> Row
$cmconcat :: [Row] -> Row
mappend :: Row -> Row -> Row
$cmappend :: Row -> Row -> Row
mempty :: Row
$cmempty :: Row
Monoid, IsList Row
Item Row ~ Element Row
Row -> Bool
Row -> CountOf (Element Row)
(Element Row -> Bool) -> Row -> Bool
forall c.
IsList c
-> (Item c ~ Element c)
-> (c -> Bool)
-> (c -> CountOf (Element c))
-> (forall a. (Eq a, a ~ Element c) => Element c -> c -> Bool)
-> (forall a. (Eq a, a ~ Element c) => Element c -> c -> Bool)
-> (forall a. (Ord a, a ~ Element c) => NonEmpty c -> Element c)
-> (forall a. (Ord a, a ~ Element c) => NonEmpty c -> Element c)
-> ((Element c -> Bool) -> c -> Bool)
-> ((Element c -> Bool) -> c -> Bool)
-> Collection c
forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
all :: (Element Row -> Bool) -> Row -> Bool
$call :: (Element Row -> Bool) -> Row -> Bool
any :: (Element Row -> Bool) -> Row -> Bool
$cany :: (Element Row -> Bool) -> Row -> Bool
minimum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
$cminimum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
maximum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
$cmaximum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
notElem :: forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
$cnotElem :: forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
elem :: forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
$celem :: forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
length :: Row -> CountOf (Element Row)
$clength :: Row -> CountOf (Element Row)
null :: Row -> Bool
$cnull :: Row -> Bool
Collection, Row -> ()
forall a. (a -> ()) -> NormalForm a
toNormalForm :: Row -> ()
$ctoNormalForm :: Row -> ()
NormalForm, IsList Row
Monoid Row
Item Row ~ Element Row
Collection Row
Eq (Element Row) => Element Row -> Row -> (Row, Row)
Eq (Element Row) => Row -> Row -> Bool
Eq (Element Row) => Row -> Row -> Maybe Row
Monoid (Item Row) => Element Row -> Row -> Element Row
NonEmpty Row -> Element Row
NonEmpty Row -> Row
CountOf (Element Row) -> Element Row -> Row
CountOf (Element Row) -> Row -> (Row, Row)
CountOf (Element Row) -> Row -> Row
Element Row -> Row
Element Row -> Row -> Row
Row -> Maybe (Element Row, Row)
Row -> Maybe (Row, Element Row)
Row -> Row
Row -> Element Row -> Row
(Element Row -> Bool) -> Row -> [Row]
(Element Row -> Bool) -> Row -> Maybe (Element Row)
(Element Row -> Bool) -> Row -> (Row, Row)
(Element Row -> Bool) -> Row -> Row
(Element Row -> Element Row -> Ordering) -> Row -> Row
forall c.
IsList c
-> (Item c ~ Element c)
-> Monoid c
-> Collection c
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> (c, c))
-> (CountOf (Element c) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> [c])
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> (c, c))
-> (Eq (Element c) => Element c -> c -> (c, c))
-> ((Element c -> Bool) -> c -> c)
-> ((Element c -> Bool) -> c -> c)
-> (Element c -> c -> c)
-> (Monoid (Item c) => Element c -> c -> Element c)
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> c)
-> ((Element c -> Bool) -> c -> (c, c))
-> (c -> c)
-> (c -> Maybe (Element c, c))
-> (c -> Maybe (c, Element c))
-> (c -> Element c -> c)
-> (Element c -> c -> c)
-> ((Element c -> Bool) -> c -> Maybe (Element c))
-> ((Element c -> Element c -> Ordering) -> c -> c)
-> (Element c -> c)
-> (NonEmpty c -> Element c)
-> (NonEmpty c -> Element c)
-> (NonEmpty c -> c)
-> (NonEmpty c -> c)
-> (CountOf (Element c) -> Element c -> c)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Maybe c)
-> (Eq (Element c) => c -> c -> Maybe c)
-> Sequential c
stripSuffix :: Eq (Element Row) => Row -> Row -> Maybe Row
$cstripSuffix :: Eq (Element Row) => Row -> Row -> Maybe Row
stripPrefix :: Eq (Element Row) => Row -> Row -> Maybe Row
$cstripPrefix :: Eq (Element Row) => Row -> Row -> Maybe Row
isInfixOf :: Eq (Element Row) => Row -> Row -> Bool
$cisInfixOf :: Eq (Element Row) => Row -> Row -> Bool
isSuffixOf :: Eq (Element Row) => Row -> Row -> Bool
$cisSuffixOf :: Eq (Element Row) => Row -> Row -> Bool
isPrefixOf :: Eq (Element Row) => Row -> Row -> Bool
$cisPrefixOf :: Eq (Element Row) => Row -> Row -> Bool
replicate :: CountOf (Element Row) -> Element Row -> Row
$creplicate :: CountOf (Element Row) -> Element Row -> Row
init :: NonEmpty Row -> Row
$cinit :: NonEmpty Row -> Row
tail :: NonEmpty Row -> Row
$ctail :: NonEmpty Row -> Row
last :: NonEmpty Row -> Element Row
$clast :: NonEmpty Row -> Element Row
head :: NonEmpty Row -> Element Row
$chead :: NonEmpty Row -> Element Row
singleton :: Element Row -> Row
$csingleton :: Element Row -> Row
sortBy :: (Element Row -> Element Row -> Ordering) -> Row -> Row
$csortBy :: (Element Row -> Element Row -> Ordering) -> Row -> Row
find :: (Element Row -> Bool) -> Row -> Maybe (Element Row)
$cfind :: (Element Row -> Bool) -> Row -> Maybe (Element Row)
cons :: Element Row -> Row -> Row
$ccons :: Element Row -> Row -> Row
snoc :: Row -> Element Row -> Row
$csnoc :: Row -> Element Row -> Row
unsnoc :: Row -> Maybe (Row, Element Row)
$cunsnoc :: Row -> Maybe (Row, Element Row)
uncons :: Row -> Maybe (Element Row, Row)
$cuncons :: Row -> Maybe (Element Row, Row)
reverse :: Row -> Row
$creverse :: Row -> Row
partition :: (Element Row -> Bool) -> Row -> (Row, Row)
$cpartition :: (Element Row -> Bool) -> Row -> (Row, Row)
filter :: (Element Row -> Bool) -> Row -> Row
$cfilter :: (Element Row -> Bool) -> Row -> Row
spanEnd :: (Element Row -> Bool) -> Row -> (Row, Row)
$cspanEnd :: (Element Row -> Bool) -> Row -> (Row, Row)
span :: (Element Row -> Bool) -> Row -> (Row, Row)
$cspan :: (Element Row -> Bool) -> Row -> (Row, Row)
intercalate :: Monoid (Item Row) => Element Row -> Row -> Element Row
$cintercalate :: Monoid (Item Row) => Element Row -> Row -> Element Row
intersperse :: Element Row -> Row -> Row
$cintersperse :: Element Row -> Row -> Row
dropWhile :: (Element Row -> Bool) -> Row -> Row
$cdropWhile :: (Element Row -> Bool) -> Row -> Row
takeWhile :: (Element Row -> Bool) -> Row -> Row
$ctakeWhile :: (Element Row -> Bool) -> Row -> Row
breakElem :: Eq (Element Row) => Element Row -> Row -> (Row, Row)
$cbreakElem :: Eq (Element Row) => Element Row -> Row -> (Row, Row)
breakEnd :: (Element Row -> Bool) -> Row -> (Row, Row)
$cbreakEnd :: (Element Row -> Bool) -> Row -> (Row, Row)
break :: (Element Row -> Bool) -> Row -> (Row, Row)
$cbreak :: (Element Row -> Bool) -> Row -> (Row, Row)
splitOn :: (Element Row -> Bool) -> Row -> [Row]
$csplitOn :: (Element Row -> Bool) -> Row -> [Row]
revSplitAt :: CountOf (Element Row) -> Row -> (Row, Row)
$crevSplitAt :: CountOf (Element Row) -> Row -> (Row, Row)
splitAt :: CountOf (Element Row) -> Row -> (Row, Row)
$csplitAt :: CountOf (Element Row) -> Row -> (Row, Row)
revDrop :: CountOf (Element Row) -> Row -> Row
$crevDrop :: CountOf (Element Row) -> Row -> Row
drop :: CountOf (Element Row) -> Row -> Row
$cdrop :: CountOf (Element Row) -> Row -> Row
revTake :: CountOf (Element Row) -> Row -> Row
$crevTake :: CountOf (Element Row) -> Row -> Row
take :: CountOf (Element Row) -> Row -> Row
$ctake :: CountOf (Element Row) -> Row -> Row
Sequential, Row -> Offset (Element Row) -> Maybe (Element Row)
(Element Row -> Bool) -> Row -> Maybe (Offset (Element Row))
forall c.
(c -> Offset (Element c) -> Maybe (Element c))
-> ((Element c -> Bool) -> c -> Maybe (Offset (Element c)))
-> IndexedCollection c
findIndex :: (Element Row -> Bool) -> Row -> Maybe (Offset (Element Row))
$cfindIndex :: (Element Row -> Bool) -> Row -> Maybe (Offset (Element Row))
! :: Row -> Offset (Element Row) -> Maybe (Element Row)
$c! :: Row -> Offset (Element Row) -> Maybe (Element Row)
IndexedCollection)

type instance Element Row = Field
instance IsList Row where
    type Item Row = Field
    toList :: Row -> [Item Row]
toList = forall l. IsList l => l -> [Item l]
toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Row -> Array Field
unRow
    fromList :: [Item Row] -> Row
fromList = Array Field -> Row
Row forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall l. IsList l => [Item l] -> l
fromList

class Record a where
    toRow :: a -> Row
    fromRow :: Row -> Either String a
instance Record Row where
    toRow :: Row -> Row
toRow = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    fromRow :: Row -> Either String Row
fromRow = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance (IsField a, IsField b) => Record (a,b) where
    toRow :: (a, b) -> Row
toRow (a
a,b
b) = forall l. IsList l => [Item l] -> l
fromList [forall a. IsField a => a -> Field
toField a
a, forall a. IsField a => a -> Field
toField b
b]
    fromRow :: Row -> Either String (a, b)
fromRow (Row Array Field
row)
        | forall a. Array a -> CountOf a
length Array Field
row forall a. Eq a => a -> a -> Bool
== CountOf Field
2 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
        | Bool
otherwise       = forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Array Field
row)
instance (IsField a, IsField b, IsField c) => Record (a,b,c) where
    toRow :: (a, b, c) -> Row
toRow (a
a,b
b,c
c) = forall l. IsList l => [Item l] -> l
fromList [forall a. IsField a => a -> Field
toField a
a, forall a. IsField a => a -> Field
toField b
b, forall a. IsField a => a -> Field
toField c
c]
    fromRow :: Row -> Either String (a, b, c)
fromRow (Row Array Field
row)
        | forall a. Array a -> CountOf a
length Array Field
row forall a. Eq a => a -> a -> Bool
== CountOf Field
3 = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
        | Bool
otherwise       = forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Array Field
row)
instance (IsField a, IsField b, IsField c, IsField d) => Record (a,b,c,d) where
    toRow :: (a, b, c, d) -> Row
toRow (a
a,b
b,c
c,d
d) = forall l. IsList l => [Item l] -> l
fromList [forall a. IsField a => a -> Field
toField a
a, forall a. IsField a => a -> Field
toField b
b, forall a. IsField a => a -> Field
toField c
c, forall a. IsField a => a -> Field
toField d
d]
    fromRow :: Row -> Either String (a, b, c, d)
fromRow (Row Array Field
row)
        | forall a. Array a -> CountOf a
length Array Field
row forall a. Eq a => a -> a -> Bool
== CountOf Field
4 = (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
                                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
                                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
                                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
        | Bool
otherwise       = forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Array Field
row)
instance (IsField a, IsField b, IsField c, IsField d, IsField e) => Record (a,b,c,d,e) where
    toRow :: (a, b, c, d, e) -> Row
toRow (a
a,b
b,c
c,d
d,e
e) = forall l. IsList l => [Item l] -> l
fromList [forall a. IsField a => a -> Field
toField a
a, forall a. IsField a => a -> Field
toField b
b, forall a. IsField a => a -> Field
toField c
c, forall a. IsField a => a -> Field
toField d
d, forall a. IsField a => a -> Field
toField e
e]
    fromRow :: Row -> Either String (a, b, c, d, e)
fromRow (Row Array Field
row)
        | forall a. Array a -> CountOf a
length Array Field
row forall a. Eq a => a -> a -> Bool
== CountOf Field
5 = (,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
4)
        | Bool
otherwise       = forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Array Field
row)
instance (IsField a, IsField b, IsField c, IsField d, IsField e, IsField f) => Record (a,b,c,d,e,f) where
    toRow :: (a, b, c, d, e, f) -> Row
toRow (a
a,b
b,c
c,d
d,e
e,f
f) = forall l. IsList l => [Item l] -> l
fromList [forall a. IsField a => a -> Field
toField a
a, forall a. IsField a => a -> Field
toField b
b, forall a. IsField a => a -> Field
toField c
c, forall a. IsField a => a -> Field
toField d
d, forall a. IsField a => a -> Field
toField e
e, forall a. IsField a => a -> Field
toField f
f]
    fromRow :: Row -> Either String (a, b, c, d, e, f)
fromRow (Row Array Field
row)
        | forall a. Array a -> CountOf a
length Array Field
row forall a. Eq a => a -> a -> Bool
== CountOf Field
6 = (,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
4)
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsField a => Field -> Either String a
fromField (Array Field
row forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
5)
        | Bool
otherwise       = forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Array Field
row)

-- | CSV Type
newtype CSV = CSV { CSV -> Array Row
unCSV :: Array Row }
  deriving (CSV -> CSV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSV -> CSV -> Bool
$c/= :: CSV -> CSV -> Bool
== :: CSV -> CSV -> Bool
$c== :: CSV -> CSV -> Bool
Eq, Int -> CSV -> ShowS
[CSV] -> ShowS
CSV -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSV] -> ShowS
$cshowList :: [CSV] -> ShowS
show :: CSV -> String
$cshow :: CSV -> String
showsPrec :: Int -> CSV -> ShowS
$cshowsPrec :: Int -> CSV -> ShowS
Show, Typeable, NonEmpty CSV -> CSV
CSV -> CSV -> CSV
forall b. Integral b => b -> CSV -> CSV
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CSV -> CSV
$cstimes :: forall b. Integral b => b -> CSV -> CSV
sconcat :: NonEmpty CSV -> CSV
$csconcat :: NonEmpty CSV -> CSV
<> :: CSV -> CSV -> CSV
$c<> :: CSV -> CSV -> CSV
Semigroup, Semigroup CSV
CSV
[CSV] -> CSV
CSV -> CSV -> CSV
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CSV] -> CSV
$cmconcat :: [CSV] -> CSV
mappend :: CSV -> CSV -> CSV
$cmappend :: CSV -> CSV -> CSV
mempty :: CSV
$cmempty :: CSV
Monoid, IsList CSV
Item CSV ~ Element CSV
CSV -> Bool
CSV -> CountOf (Element CSV)
(Element CSV -> Bool) -> CSV -> Bool
forall c.
IsList c
-> (Item c ~ Element c)
-> (c -> Bool)
-> (c -> CountOf (Element c))
-> (forall a. (Eq a, a ~ Element c) => Element c -> c -> Bool)
-> (forall a. (Eq a, a ~ Element c) => Element c -> c -> Bool)
-> (forall a. (Ord a, a ~ Element c) => NonEmpty c -> Element c)
-> (forall a. (Ord a, a ~ Element c) => NonEmpty c -> Element c)
-> ((Element c -> Bool) -> c -> Bool)
-> ((Element c -> Bool) -> c -> Bool)
-> Collection c
forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
all :: (Element CSV -> Bool) -> CSV -> Bool
$call :: (Element CSV -> Bool) -> CSV -> Bool
any :: (Element CSV -> Bool) -> CSV -> Bool
$cany :: (Element CSV -> Bool) -> CSV -> Bool
minimum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
$cminimum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
maximum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
$cmaximum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
notElem :: forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
$cnotElem :: forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
elem :: forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
$celem :: forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
length :: CSV -> CountOf (Element CSV)
$clength :: CSV -> CountOf (Element CSV)
null :: CSV -> Bool
$cnull :: CSV -> Bool
Collection, CSV -> ()
forall a. (a -> ()) -> NormalForm a
toNormalForm :: CSV -> ()
$ctoNormalForm :: CSV -> ()
NormalForm, IsList CSV
Monoid CSV
Item CSV ~ Element CSV
Collection CSV
Eq (Element CSV) => Element CSV -> CSV -> (CSV, CSV)
Eq (Element CSV) => CSV -> CSV -> Bool
Eq (Element CSV) => CSV -> CSV -> Maybe CSV
Monoid (Item CSV) => Element CSV -> CSV -> Element CSV
NonEmpty CSV -> Element CSV
NonEmpty CSV -> CSV
CountOf (Element CSV) -> Element CSV -> CSV
CountOf (Element CSV) -> CSV -> (CSV, CSV)
CountOf (Element CSV) -> CSV -> CSV
Element CSV -> CSV
Element CSV -> CSV -> CSV
CSV -> Maybe (Element CSV, CSV)
CSV -> Maybe (CSV, Element CSV)
CSV -> CSV
CSV -> Element CSV -> CSV
(Element CSV -> Bool) -> CSV -> [CSV]
(Element CSV -> Bool) -> CSV -> Maybe (Element CSV)
(Element CSV -> Bool) -> CSV -> (CSV, CSV)
(Element CSV -> Bool) -> CSV -> CSV
(Element CSV -> Element CSV -> Ordering) -> CSV -> CSV
forall c.
IsList c
-> (Item c ~ Element c)
-> Monoid c
-> Collection c
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> c)
-> (CountOf (Element c) -> c -> (c, c))
-> (CountOf (Element c) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> [c])
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> (c, c))
-> (Eq (Element c) => Element c -> c -> (c, c))
-> ((Element c -> Bool) -> c -> c)
-> ((Element c -> Bool) -> c -> c)
-> (Element c -> c -> c)
-> (Monoid (Item c) => Element c -> c -> Element c)
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> (c, c))
-> ((Element c -> Bool) -> c -> c)
-> ((Element c -> Bool) -> c -> (c, c))
-> (c -> c)
-> (c -> Maybe (Element c, c))
-> (c -> Maybe (c, Element c))
-> (c -> Element c -> c)
-> (Element c -> c -> c)
-> ((Element c -> Bool) -> c -> Maybe (Element c))
-> ((Element c -> Element c -> Ordering) -> c -> c)
-> (Element c -> c)
-> (NonEmpty c -> Element c)
-> (NonEmpty c -> Element c)
-> (NonEmpty c -> c)
-> (NonEmpty c -> c)
-> (CountOf (Element c) -> Element c -> c)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Bool)
-> (Eq (Element c) => c -> c -> Maybe c)
-> (Eq (Element c) => c -> c -> Maybe c)
-> Sequential c
stripSuffix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
$cstripSuffix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
stripPrefix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
$cstripPrefix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
isInfixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
$cisInfixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
isSuffixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
$cisSuffixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
isPrefixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
$cisPrefixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
replicate :: CountOf (Element CSV) -> Element CSV -> CSV
$creplicate :: CountOf (Element CSV) -> Element CSV -> CSV
init :: NonEmpty CSV -> CSV
$cinit :: NonEmpty CSV -> CSV
tail :: NonEmpty CSV -> CSV
$ctail :: NonEmpty CSV -> CSV
last :: NonEmpty CSV -> Element CSV
$clast :: NonEmpty CSV -> Element CSV
head :: NonEmpty CSV -> Element CSV
$chead :: NonEmpty CSV -> Element CSV
singleton :: Element CSV -> CSV
$csingleton :: Element CSV -> CSV
sortBy :: (Element CSV -> Element CSV -> Ordering) -> CSV -> CSV
$csortBy :: (Element CSV -> Element CSV -> Ordering) -> CSV -> CSV
find :: (Element CSV -> Bool) -> CSV -> Maybe (Element CSV)
$cfind :: (Element CSV -> Bool) -> CSV -> Maybe (Element CSV)
cons :: Element CSV -> CSV -> CSV
$ccons :: Element CSV -> CSV -> CSV
snoc :: CSV -> Element CSV -> CSV
$csnoc :: CSV -> Element CSV -> CSV
unsnoc :: CSV -> Maybe (CSV, Element CSV)
$cunsnoc :: CSV -> Maybe (CSV, Element CSV)
uncons :: CSV -> Maybe (Element CSV, CSV)
$cuncons :: CSV -> Maybe (Element CSV, CSV)
reverse :: CSV -> CSV
$creverse :: CSV -> CSV
partition :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
$cpartition :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
filter :: (Element CSV -> Bool) -> CSV -> CSV
$cfilter :: (Element CSV -> Bool) -> CSV -> CSV
spanEnd :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
$cspanEnd :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
span :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
$cspan :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
intercalate :: Monoid (Item CSV) => Element CSV -> CSV -> Element CSV
$cintercalate :: Monoid (Item CSV) => Element CSV -> CSV -> Element CSV
intersperse :: Element CSV -> CSV -> CSV
$cintersperse :: Element CSV -> CSV -> CSV
dropWhile :: (Element CSV -> Bool) -> CSV -> CSV
$cdropWhile :: (Element CSV -> Bool) -> CSV -> CSV
takeWhile :: (Element CSV -> Bool) -> CSV -> CSV
$ctakeWhile :: (Element CSV -> Bool) -> CSV -> CSV
breakElem :: Eq (Element CSV) => Element CSV -> CSV -> (CSV, CSV)
$cbreakElem :: Eq (Element CSV) => Element CSV -> CSV -> (CSV, CSV)
breakEnd :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
$cbreakEnd :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
break :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
$cbreak :: (Element CSV -> Bool) -> CSV -> (CSV, CSV)
splitOn :: (Element CSV -> Bool) -> CSV -> [CSV]
$csplitOn :: (Element CSV -> Bool) -> CSV -> [CSV]
revSplitAt :: CountOf (Element CSV) -> CSV -> (CSV, CSV)
$crevSplitAt :: CountOf (Element CSV) -> CSV -> (CSV, CSV)
splitAt :: CountOf (Element CSV) -> CSV -> (CSV, CSV)
$csplitAt :: CountOf (Element CSV) -> CSV -> (CSV, CSV)
revDrop :: CountOf (Element CSV) -> CSV -> CSV
$crevDrop :: CountOf (Element CSV) -> CSV -> CSV
drop :: CountOf (Element CSV) -> CSV -> CSV
$cdrop :: CountOf (Element CSV) -> CSV -> CSV
revTake :: CountOf (Element CSV) -> CSV -> CSV
$crevTake :: CountOf (Element CSV) -> CSV -> CSV
take :: CountOf (Element CSV) -> CSV -> CSV
$ctake :: CountOf (Element CSV) -> CSV -> CSV
Sequential, CSV -> Offset (Element CSV) -> Maybe (Element CSV)
(Element CSV -> Bool) -> CSV -> Maybe (Offset (Element CSV))
forall c.
(c -> Offset (Element c) -> Maybe (Element c))
-> ((Element c -> Bool) -> c -> Maybe (Offset (Element c)))
-> IndexedCollection c
findIndex :: (Element CSV -> Bool) -> CSV -> Maybe (Offset (Element CSV))
$cfindIndex :: (Element CSV -> Bool) -> CSV -> Maybe (Offset (Element CSV))
! :: CSV -> Offset (Element CSV) -> Maybe (Element CSV)
$c! :: CSV -> Offset (Element CSV) -> Maybe (Element CSV)
IndexedCollection)

type instance Element CSV = Row

instance IsList CSV where
    type Item CSV = Row
    toList :: CSV -> [Item CSV]
toList = forall l. IsList l => l -> [Item l]
toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CSV -> Array Row
unCSV
    fromList :: [Item CSV] -> CSV
fromList = Array Row -> CSV
CSV forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall l. IsList l => [Item l] -> l
fromList