{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Foundation.Format.CSV.Types
(
CSV
, unCSV
, Row
, unRow
, Record(..)
, Field(..)
, Escaping(..)
, IsField(..)
, 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)
data Field
= FieldInteger Integer
| FieldDouble Double
| FieldString String Escaping
deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
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
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
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) = Integer -> ()
forall a. NormalForm a => a -> ()
toNormalForm Integer
i
toNormalForm (FieldDouble Double
d) = Double -> ()
forall a. NormalForm a => a -> ()
toNormalForm Double
d
toNormalForm (FieldString String
s Escaping
e) = String -> ()
forall a. NormalForm a => a -> ()
toNormalForm String
s () -> () -> ()
`seq` Escaping -> ()
forall a. NormalForm a => a -> ()
toNormalForm Escaping
e
instance Arbitrary Field where
arbitrary :: Gen Field
arbitrary = NonEmpty [(Word, Gen Field)] -> Gen Field
forall a. NonEmpty [(Word, Gen a)] -> Gen a
frequency (NonEmpty [(Word, Gen Field)] -> Gen Field)
-> NonEmpty [(Word, Gen Field)] -> Gen Field
forall a b. (a -> b) -> a -> b
$ [(Word, Gen Field)] -> NonEmpty [(Word, Gen Field)]
forall c. Collection c => c -> NonEmpty c
nonEmpty_ [ (Word
1, Integer -> Field
FieldInteger (Integer -> Field) -> Gen Integer -> Gen Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary)
, (Word
1, Double -> Field
FieldDouble (Double -> Field) -> Gen Double -> Gen Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary)
, (Word
3, String -> Field
string (String -> Field) -> Gen String -> Gen Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary)
]
data Escaping = NoEscape | Escape | DoubleEscape
deriving (Escaping -> Escaping -> Bool
(Escaping -> Escaping -> Bool)
-> (Escaping -> Escaping -> Bool) -> Eq Escaping
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
Eq Escaping
-> (Escaping -> Escaping -> Ordering)
-> (Escaping -> Escaping -> Bool)
-> (Escaping -> Escaping -> Bool)
-> (Escaping -> Escaping -> Bool)
-> (Escaping -> Escaping -> Bool)
-> (Escaping -> Escaping -> Escaping)
-> (Escaping -> Escaping -> Escaping)
-> Ord 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
$cp1Ord :: Eq Escaping
Ord, Int -> Escaping
Escaping -> Int
Escaping -> [Escaping]
Escaping -> Escaping
Escaping -> Escaping -> [Escaping]
Escaping -> Escaping -> Escaping -> [Escaping]
(Escaping -> Escaping)
-> (Escaping -> Escaping)
-> (Int -> Escaping)
-> (Escaping -> Int)
-> (Escaping -> [Escaping])
-> (Escaping -> Escaping -> [Escaping])
-> (Escaping -> Escaping -> [Escaping])
-> (Escaping -> Escaping -> Escaping -> [Escaping])
-> Enum 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
Escaping -> Escaping -> Bounded Escaping
forall a. a -> a -> Bounded a
maxBound :: Escaping
$cmaxBound :: Escaping
minBound :: Escaping
$cminBound :: Escaping
Bounded, Int -> Escaping -> ShowS
[Escaping] -> ShowS
Escaping -> String
(Int -> Escaping -> ShowS)
-> (Escaping -> String) -> ([Escaping] -> ShowS) -> Show Escaping
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 = Field -> Field
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
fromField :: Field -> Either String Field
fromField = Field -> Either String Field
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 String
forall a. Monoid a => a
mempty Escaping
NoEscape
toField (Just a
a) = a -> Field
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 = Maybe a -> Either String (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField Field
stuff
fromField Field
stuff = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField Field
stuff
fromIntegralField :: Integral b => Field -> Either String b
fromIntegralField :: Field -> Either String b
fromIntegralField (FieldString String
str Escaping
NoEscape) = case String -> Maybe Integer
readInteger String
str of
Maybe Integer
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left String
"Invalid integral field"
Just Integer
v -> b -> Either String b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either String b) -> b -> Either String b
forall a b. (a -> b) -> a -> b
$ Integer -> b
forall a. Integral a => Integer -> a
fromInteger Integer
v
fromIntegralField (FieldInteger Integer
v) = b -> Either String b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> b
forall a. Integral a => Integer -> a
fromInteger Integer
v)
fromIntegralField Field
_ = String -> Either String b
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 -> String -> Either String Double
forall a b. a -> Either a b
Left String
"Invalid double field"
Just Double
v -> Double -> Either String Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
v
fromDoubleField (FieldDouble Double
v) = Double -> Either String Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
v
fromDoubleField Field
_ = String -> Either String Double
forall a b. a -> Either a b
Left String
"Expected double value"
instance IsField Bool where
toField :: Bool -> Field
toField = String -> Field
forall a. IsField a => a -> Field
toField (String -> Field) -> (Bool -> String) -> Bool -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> String
forall a. Show a => a -> String
show
fromField :: Field -> Either String Bool
fromField (FieldString String
"True" Escaping
NoEscape) = Bool -> Either String Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
fromField (FieldString String
"False" Escaping
NoEscape) = Bool -> Either String Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
fromField Field
_ = String -> Either String Bool
forall a b. a -> Either a b
Left String
"not a boolean value"
instance IsField Int8 where
toField :: Int8 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Int8 -> Integer) -> Int8 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int8 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Int8
fromField = Field -> Either String Int8
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int16 where
toField :: Int16 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Int16 -> Integer) -> Int16 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int16 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Int16
fromField = Field -> Either String Int16
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int32 where
toField :: Int32 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Int32 -> Integer) -> Int32 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Int32
fromField = Field -> Either String Int32
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int64 where
toField :: Int64 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Int64 -> Integer) -> Int64 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Int64
fromField = Field -> Either String Int64
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Int where
toField :: Int -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Int -> Integer) -> Int -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Int
fromField = Field -> Either String Int
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word8 where
toField :: Word8 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word8 -> Integer) -> Word8 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word8
fromField = Field -> Either String Word8
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word16 where
toField :: Word16 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word16 -> Integer) -> Word16 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word16 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word16
fromField = Field -> Either String Word16
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word32 where
toField :: Word32 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word32 -> Integer) -> Word32 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word32
fromField = Field -> Either String Word32
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word64 where
toField :: Word64 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word64 -> Integer) -> Word64 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word64
fromField = Field -> Either String Word64
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word where
toField :: Word -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word -> Integer) -> Word -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word
fromField = Field -> Either String Word
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word128 where
toField :: Word128 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word128 -> Integer) -> Word128 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word128 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word128
fromField = Field -> Either String Word128
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Word256 where
toField :: Word256 -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Word256 -> Integer) -> Word256 -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word256 -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Word256
fromField = Field -> Either String Word256
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 = Field -> Either String Integer
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField Natural where
toField :: Natural -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (Natural -> Integer) -> Natural -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String Natural
fromField = Field -> Either String Natural
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 (String -> Field) -> (Char -> String) -> Char -> Field
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' -> Char -> Either String Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
| Bool
otherwise -> String -> Either String Char
forall a b. a -> Either a b
Left String
"Expected a char, but received a String"
Maybe (Char, String)
Nothing -> String -> Either String Char
forall a b. a -> Either a b
Left String
"Expected a char"
fromField Field
_ = String -> Either String Char
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 (Integer -> Field) -> (Offset a -> Integer) -> Offset a -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Offset a -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String (Offset a)
fromField = Field -> Either String (Offset a)
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField (CountOf a) where
toField :: CountOf a -> Field
toField = Integer -> Field
FieldInteger (Integer -> Field) -> (CountOf a -> Integer) -> CountOf a -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CountOf a -> Integer
forall b a. Into b a => a -> b
into
fromField :: Field -> Either String (CountOf a)
fromField = Field -> Either String (CountOf a)
forall b. Integral b => Field -> Either String b
fromIntegralField
instance IsField [Char] where
toField :: String -> Field
toField = String -> Field
string (String -> Field) -> (String -> String) -> String -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
forall a. IsString a => String -> a
fromString
fromField :: Field -> Either String String
fromField (FieldString String
str Escaping
_) = String -> Either String String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String -> [Item String]
forall l. IsList l => l -> [Item l]
toList String
str
fromField Field
_ = String -> Either String String
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
_) = String -> Either String String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str
fromField Field
_ = String -> Either String String
forall a b. a -> Either a b
Left String
"Expected a UTF8 String"
integral :: Into Integer a => a -> Field
integral :: a -> Field
integral = Integer -> Field
FieldInteger (Integer -> Field) -> (a -> Integer) -> a -> Field
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Integer
forall b a. Into b a => a -> b
into
float :: Double -> Field
float :: Double -> Field
float = Double -> Field
FieldDouble
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"'
f :: Char -> Bool
f Char
c = Char
c Char -> String -> Bool
`elem` String
",\r\n"
newtype Row = Row { Row -> Array Field
unRow :: Array Field }
deriving (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
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
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
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, b -> Row -> Row
NonEmpty Row -> Row
Row -> Row -> Row
(Row -> Row -> Row)
-> (NonEmpty Row -> Row)
-> (forall b. Integral b => b -> Row -> Row)
-> Semigroup 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 :: 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
Semigroup Row
-> Row -> (Row -> Row -> Row) -> ([Row] -> Row) -> Monoid 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
$cp1Monoid :: Semigroup Row
Monoid, IsList Row
Item Row ~ Element Row
IsList Row
-> (Item Row ~ Element Row)
-> (Row -> Bool)
-> (Row -> CountOf (Element Row))
-> (forall a.
(Eq a, a ~ Element Row) =>
Element Row -> Row -> Bool)
-> (forall a.
(Eq a, a ~ Element Row) =>
Element Row -> Row -> Bool)
-> (forall a.
(Ord a, a ~ Element Row) =>
NonEmpty Row -> Element Row)
-> (forall a.
(Ord a, a ~ Element Row) =>
NonEmpty Row -> Element Row)
-> ((Element Row -> Bool) -> Row -> Bool)
-> ((Element Row -> Bool) -> Row -> Bool)
-> Collection Row
NonEmpty Row -> Element Row
Element Row -> Row -> Bool
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 :: NonEmpty Row -> Element Row
$cminimum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
maximum :: NonEmpty Row -> Element Row
$cmaximum :: forall a. (Ord a, a ~ Element Row) => NonEmpty Row -> Element Row
notElem :: Element Row -> Row -> Bool
$cnotElem :: forall a. (Eq a, a ~ Element Row) => Element Row -> Row -> Bool
elem :: 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
$cp2Collection :: Item Row ~ Element Row
$cp1Collection :: IsList Row
Collection, Row -> ()
(Row -> ()) -> NormalForm Row
forall a. (a -> ()) -> NormalForm a
toNormalForm :: Row -> ()
$ctoNormalForm :: Row -> ()
NormalForm, IsList Row
Monoid Row
Item Row ~ Element Row
Collection Row
IsList Row
-> (Item Row ~ Element Row)
-> Monoid Row
-> Collection Row
-> (CountOf (Element Row) -> Row -> Row)
-> (CountOf (Element Row) -> Row -> Row)
-> (CountOf (Element Row) -> Row -> Row)
-> (CountOf (Element Row) -> Row -> Row)
-> (CountOf (Element Row) -> Row -> (Row, Row))
-> (CountOf (Element Row) -> Row -> (Row, Row))
-> ((Element Row -> Bool) -> Row -> [Row])
-> ((Element Row -> Bool) -> Row -> (Row, Row))
-> ((Element Row -> Bool) -> Row -> (Row, Row))
-> (Eq (Element Row) => Element Row -> Row -> (Row, Row))
-> ((Element Row -> Bool) -> Row -> Row)
-> ((Element Row -> Bool) -> Row -> Row)
-> (Element Row -> Row -> Row)
-> (Monoid (Item Row) => Element Row -> Row -> Element Row)
-> ((Element Row -> Bool) -> Row -> (Row, Row))
-> ((Element Row -> Bool) -> Row -> (Row, Row))
-> ((Element Row -> Bool) -> Row -> Row)
-> ((Element Row -> Bool) -> Row -> (Row, Row))
-> (Row -> Row)
-> (Row -> Maybe (Element Row, Row))
-> (Row -> Maybe (Row, Element Row))
-> (Row -> Element Row -> Row)
-> (Element Row -> Row -> Row)
-> ((Element Row -> Bool) -> Row -> Maybe (Element Row))
-> ((Element Row -> Element Row -> Ordering) -> Row -> Row)
-> (Element Row -> Row)
-> (NonEmpty Row -> Element Row)
-> (NonEmpty Row -> Element Row)
-> (NonEmpty Row -> Row)
-> (NonEmpty Row -> Row)
-> (CountOf (Element Row) -> Element Row -> Row)
-> (Eq (Element Row) => Row -> Row -> Bool)
-> (Eq (Element Row) => Row -> Row -> Bool)
-> (Eq (Element Row) => Row -> Row -> Bool)
-> (Eq (Element Row) => Row -> Row -> Maybe Row)
-> (Eq (Element Row) => Row -> Row -> Maybe Row)
-> Sequential 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)
Element Row -> Row -> Element Row
Element Row -> Row -> Row
Row -> Maybe (Element Row, Row)
Row -> Maybe (Row, Element Row)
Row -> Row
Row -> Element Row -> Row
Row -> Row -> Bool
Row -> Row -> Maybe 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 :: Row -> Row -> Maybe Row
$cstripSuffix :: Eq (Element Row) => Row -> Row -> Maybe Row
stripPrefix :: Row -> Row -> Maybe Row
$cstripPrefix :: Eq (Element Row) => Row -> Row -> Maybe Row
isInfixOf :: Row -> Row -> Bool
$cisInfixOf :: Eq (Element Row) => Row -> Row -> Bool
isSuffixOf :: Row -> Row -> Bool
$cisSuffixOf :: Eq (Element Row) => Row -> Row -> Bool
isPrefixOf :: 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 :: 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 :: 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
$cp4Sequential :: Collection Row
$cp3Sequential :: Monoid Row
$cp2Sequential :: Item Row ~ Element Row
$cp1Sequential :: IsList Row
Sequential, Row -> Offset (Element Row) -> Maybe (Element Row)
(Element Row -> Bool) -> Row -> Maybe (Offset (Element Row))
(Row -> Offset (Element Row) -> Maybe (Element Row))
-> ((Element Row -> Bool) -> Row -> Maybe (Offset (Element Row)))
-> IndexedCollection 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 = Array Field -> [Field]
forall l. IsList l => l -> [Item l]
toList (Array Field -> [Field]) -> (Row -> Array Field) -> Row -> [Field]
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 (Array Field -> Row) -> ([Field] -> Array Field) -> [Field] -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Field] -> Array Field
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 = Row -> Row
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
fromRow :: Row -> Either String Row
fromRow = Row -> Either String Row
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) = [Item Row] -> Row
forall l. IsList l => [Item l] -> l
fromList [a -> Field
forall a. IsField a => a -> Field
toField a
a, b -> Field
forall a. IsField a => a -> Field
toField b
b]
fromRow :: Row -> Either String (a, b)
fromRow (Row Array Field
row)
| Array Field -> CountOf Field
forall a. Array a -> CountOf a
length Array Field
row CountOf Field -> CountOf Field -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Field
2 = (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0) Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String b
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
| Bool
otherwise = String -> Either String (a, b)
forall a b. a -> Either a b
Left (Array Field -> String
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) = [Item Row] -> Row
forall l. IsList l => [Item l] -> l
fromList [a -> Field
forall a. IsField a => a -> Field
toField a
a, b -> Field
forall a. IsField a => a -> Field
toField b
b, c -> Field
forall a. IsField a => a -> Field
toField c
c]
fromRow :: Row -> Either String (a, b, c)
fromRow (Row Array Field
row)
| Array Field -> CountOf Field
forall a. Array a -> CountOf a
length Array Field
row CountOf Field -> CountOf Field -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Field
3 = (,,) (a -> b -> c -> (a, b, c))
-> Either String a -> Either String (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
Either String (b -> c -> (a, b, c))
-> Either String b -> Either String (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String b
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
Either String (c -> (a, b, c))
-> Either String c -> Either String (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String c
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
| Bool
otherwise = String -> Either String (a, b, c)
forall a b. a -> Either a b
Left (Array Field -> String
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) = [Item Row] -> Row
forall l. IsList l => [Item l] -> l
fromList [a -> Field
forall a. IsField a => a -> Field
toField a
a, b -> Field
forall a. IsField a => a -> Field
toField b
b, c -> Field
forall a. IsField a => a -> Field
toField c
c, d -> Field
forall a. IsField a => a -> Field
toField d
d]
fromRow :: Row -> Either String (a, b, c, d)
fromRow (Row Array Field
row)
| Array Field -> CountOf Field
forall a. Array a -> CountOf a
length Array Field
row CountOf Field -> CountOf Field -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Field
4 = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Either String a -> Either String (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
Either String (b -> c -> d -> (a, b, c, d))
-> Either String b -> Either String (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String b
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
Either String (c -> d -> (a, b, c, d))
-> Either String c -> Either String (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String c
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
Either String (d -> (a, b, c, d))
-> Either String d -> Either String (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String d
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
| Bool
otherwise = String -> Either String (a, b, c, d)
forall a b. a -> Either a b
Left (Array Field -> String
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) = [Item Row] -> Row
forall l. IsList l => [Item l] -> l
fromList [a -> Field
forall a. IsField a => a -> Field
toField a
a, b -> Field
forall a. IsField a => a -> Field
toField b
b, c -> Field
forall a. IsField a => a -> Field
toField c
c, d -> Field
forall a. IsField a => a -> Field
toField d
d, e -> Field
forall a. IsField a => a -> Field
toField e
e]
fromRow :: Row -> Either String (a, b, c, d, e)
fromRow (Row Array Field
row)
| Array Field -> CountOf Field
forall a. Array a -> CountOf a
length Array Field
row CountOf Field -> CountOf Field -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Field
5 = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Either String a
-> Either String (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
Either String (b -> c -> d -> e -> (a, b, c, d, e))
-> Either String b
-> Either String (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String b
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
Either String (c -> d -> e -> (a, b, c, d, e))
-> Either String c -> Either String (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String c
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
Either String (d -> e -> (a, b, c, d, e))
-> Either String d -> Either String (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String d
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
Either String (e -> (a, b, c, d, e))
-> Either String e -> Either String (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String e
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
4)
| Bool
otherwise = String -> Either String (a, b, c, d, e)
forall a b. a -> Either a b
Left (Array Field -> String
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) = [Item Row] -> Row
forall l. IsList l => [Item l] -> l
fromList [a -> Field
forall a. IsField a => a -> Field
toField a
a, b -> Field
forall a. IsField a => a -> Field
toField b
b, c -> Field
forall a. IsField a => a -> Field
toField c
c, d -> Field
forall a. IsField a => a -> Field
toField d
d, e -> Field
forall a. IsField a => a -> Field
toField e
e, f -> Field
forall a. IsField a => a -> Field
toField f
f]
fromRow :: Row -> Either String (a, b, c, d, e, f)
fromRow (Row Array Field
row)
| Array Field -> CountOf Field
forall a. Array a -> CountOf a
length Array Field
row CountOf Field -> CountOf Field -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Field
6 = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String a
-> Either String (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Either String a
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
0)
Either String (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String b
-> Either String (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String b
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
1)
Either String (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Either String c
-> Either String (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String c
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
2)
Either String (d -> e -> f -> (a, b, c, d, e, f))
-> Either String d -> Either String (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String d
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
3)
Either String (e -> f -> (a, b, c, d, e, f))
-> Either String e -> Either String (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String e
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
4)
Either String (f -> (a, b, c, d, e, f))
-> Either String f -> Either String (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field -> Either String f
forall a. IsField a => Field -> Either String a
fromField (Array Field
row Array Field -> Offset Field -> Field
forall ty. Array ty -> Offset ty -> ty
`unsafeIndex` Offset Field
5)
| Bool
otherwise = String -> Either String (a, b, c, d, e, f)
forall a b. a -> Either a b
Left (Array Field -> String
forall a. Show a => a -> String
show Array Field
row)
newtype CSV = CSV { CSV -> Array Row
unCSV :: Array Row }
deriving (CSV -> CSV -> Bool
(CSV -> CSV -> Bool) -> (CSV -> CSV -> Bool) -> Eq CSV
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
(Int -> CSV -> ShowS)
-> (CSV -> String) -> ([CSV] -> ShowS) -> Show CSV
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, b -> CSV -> CSV
NonEmpty CSV -> CSV
CSV -> CSV -> CSV
(CSV -> CSV -> CSV)
-> (NonEmpty CSV -> CSV)
-> (forall b. Integral b => b -> CSV -> CSV)
-> Semigroup 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 :: 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
Semigroup CSV
-> CSV -> (CSV -> CSV -> CSV) -> ([CSV] -> CSV) -> Monoid 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
$cp1Monoid :: Semigroup CSV
Monoid, IsList CSV
Item CSV ~ Element CSV
IsList CSV
-> (Item CSV ~ Element CSV)
-> (CSV -> Bool)
-> (CSV -> CountOf (Element CSV))
-> (forall a.
(Eq a, a ~ Element CSV) =>
Element CSV -> CSV -> Bool)
-> (forall a.
(Eq a, a ~ Element CSV) =>
Element CSV -> CSV -> Bool)
-> (forall a.
(Ord a, a ~ Element CSV) =>
NonEmpty CSV -> Element CSV)
-> (forall a.
(Ord a, a ~ Element CSV) =>
NonEmpty CSV -> Element CSV)
-> ((Element CSV -> Bool) -> CSV -> Bool)
-> ((Element CSV -> Bool) -> CSV -> Bool)
-> Collection CSV
NonEmpty CSV -> Element CSV
Element CSV -> CSV -> Bool
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 :: NonEmpty CSV -> Element CSV
$cminimum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
maximum :: NonEmpty CSV -> Element CSV
$cmaximum :: forall a. (Ord a, a ~ Element CSV) => NonEmpty CSV -> Element CSV
notElem :: Element CSV -> CSV -> Bool
$cnotElem :: forall a. (Eq a, a ~ Element CSV) => Element CSV -> CSV -> Bool
elem :: 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
$cp2Collection :: Item CSV ~ Element CSV
$cp1Collection :: IsList CSV
Collection, CSV -> ()
(CSV -> ()) -> NormalForm CSV
forall a. (a -> ()) -> NormalForm a
toNormalForm :: CSV -> ()
$ctoNormalForm :: CSV -> ()
NormalForm, IsList CSV
Monoid CSV
Item CSV ~ Element CSV
Collection CSV
IsList CSV
-> (Item CSV ~ Element CSV)
-> Monoid CSV
-> Collection CSV
-> (CountOf (Element CSV) -> CSV -> CSV)
-> (CountOf (Element CSV) -> CSV -> CSV)
-> (CountOf (Element CSV) -> CSV -> CSV)
-> (CountOf (Element CSV) -> CSV -> CSV)
-> (CountOf (Element CSV) -> CSV -> (CSV, CSV))
-> (CountOf (Element CSV) -> CSV -> (CSV, CSV))
-> ((Element CSV -> Bool) -> CSV -> [CSV])
-> ((Element CSV -> Bool) -> CSV -> (CSV, CSV))
-> ((Element CSV -> Bool) -> CSV -> (CSV, CSV))
-> (Eq (Element CSV) => Element CSV -> CSV -> (CSV, CSV))
-> ((Element CSV -> Bool) -> CSV -> CSV)
-> ((Element CSV -> Bool) -> CSV -> CSV)
-> (Element CSV -> CSV -> CSV)
-> (Monoid (Item CSV) => Element CSV -> CSV -> Element CSV)
-> ((Element CSV -> Bool) -> CSV -> (CSV, CSV))
-> ((Element CSV -> Bool) -> CSV -> (CSV, CSV))
-> ((Element CSV -> Bool) -> CSV -> CSV)
-> ((Element CSV -> Bool) -> CSV -> (CSV, CSV))
-> (CSV -> CSV)
-> (CSV -> Maybe (Element CSV, CSV))
-> (CSV -> Maybe (CSV, Element CSV))
-> (CSV -> Element CSV -> CSV)
-> (Element CSV -> CSV -> CSV)
-> ((Element CSV -> Bool) -> CSV -> Maybe (Element CSV))
-> ((Element CSV -> Element CSV -> Ordering) -> CSV -> CSV)
-> (Element CSV -> CSV)
-> (NonEmpty CSV -> Element CSV)
-> (NonEmpty CSV -> Element CSV)
-> (NonEmpty CSV -> CSV)
-> (NonEmpty CSV -> CSV)
-> (CountOf (Element CSV) -> Element CSV -> CSV)
-> (Eq (Element CSV) => CSV -> CSV -> Bool)
-> (Eq (Element CSV) => CSV -> CSV -> Bool)
-> (Eq (Element CSV) => CSV -> CSV -> Bool)
-> (Eq (Element CSV) => CSV -> CSV -> Maybe CSV)
-> (Eq (Element CSV) => CSV -> CSV -> Maybe CSV)
-> Sequential 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)
Element CSV -> CSV -> Element CSV
Element CSV -> CSV -> CSV
CSV -> Maybe (Element CSV, CSV)
CSV -> Maybe (CSV, Element CSV)
CSV -> CSV
CSV -> Element CSV -> CSV
CSV -> CSV -> Bool
CSV -> CSV -> Maybe 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 :: CSV -> CSV -> Maybe CSV
$cstripSuffix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
stripPrefix :: CSV -> CSV -> Maybe CSV
$cstripPrefix :: Eq (Element CSV) => CSV -> CSV -> Maybe CSV
isInfixOf :: CSV -> CSV -> Bool
$cisInfixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
isSuffixOf :: CSV -> CSV -> Bool
$cisSuffixOf :: Eq (Element CSV) => CSV -> CSV -> Bool
isPrefixOf :: 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 :: 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 :: 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
$cp4Sequential :: Collection CSV
$cp3Sequential :: Monoid CSV
$cp2Sequential :: Item CSV ~ Element CSV
$cp1Sequential :: IsList CSV
Sequential, CSV -> Offset (Element CSV) -> Maybe (Element CSV)
(Element CSV -> Bool) -> CSV -> Maybe (Offset (Element CSV))
(CSV -> Offset (Element CSV) -> Maybe (Element CSV))
-> ((Element CSV -> Bool) -> CSV -> Maybe (Offset (Element CSV)))
-> IndexedCollection 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 = Array Row -> [Row]
forall l. IsList l => l -> [Item l]
toList (Array Row -> [Row]) -> (CSV -> Array Row) -> CSV -> [Row]
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 (Array Row -> CSV) -> ([Row] -> Array Row) -> [Row] -> CSV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Row] -> Array Row
forall l. IsList l => [Item l] -> l
fromList