{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Siphon.Types
  ( Siphon (..)
  , Indexed (..)
  , SiphonError (..)
  , RowError (..)
  , CellError (..)
  ) where

import Control.Exception (Exception)
import Data.Functor.Classes (Eq1, Show1, liftEq, liftShowsPrec)
import Data.Text (Text)
import Data.Vector (Vector)

data CellError = CellError
  { CellError -> Int
cellErrorColumn :: !Int
  , CellError -> Text
cellErrorContent :: !Text
  }
  deriving (Int -> CellError -> ShowS
[CellError] -> ShowS
CellError -> String
(Int -> CellError -> ShowS)
-> (CellError -> String)
-> ([CellError] -> ShowS)
-> Show CellError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellError -> ShowS
showsPrec :: Int -> CellError -> ShowS
$cshow :: CellError -> String
show :: CellError -> String
$cshowList :: [CellError] -> ShowS
showList :: [CellError] -> ShowS
Show, ReadPrec [CellError]
ReadPrec CellError
Int -> ReadS CellError
ReadS [CellError]
(Int -> ReadS CellError)
-> ReadS [CellError]
-> ReadPrec CellError
-> ReadPrec [CellError]
-> Read CellError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellError
readsPrec :: Int -> ReadS CellError
$creadList :: ReadS [CellError]
readList :: ReadS [CellError]
$creadPrec :: ReadPrec CellError
readPrec :: ReadPrec CellError
$creadListPrec :: ReadPrec [CellError]
readListPrec :: ReadPrec [CellError]
Read, CellError -> CellError -> Bool
(CellError -> CellError -> Bool)
-> (CellError -> CellError -> Bool) -> Eq CellError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellError -> CellError -> Bool
== :: CellError -> CellError -> Bool
$c/= :: CellError -> CellError -> Bool
/= :: CellError -> CellError -> Bool
Eq)

newtype Indexed a = Indexed
  { forall a. Indexed a -> Int
indexedIndex :: Int
  }
  deriving (Indexed a -> Indexed a -> Bool
(Indexed a -> Indexed a -> Bool)
-> (Indexed a -> Indexed a -> Bool) -> Eq (Indexed a)
forall a. Indexed a -> Indexed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Indexed a -> Indexed a -> Bool
== :: Indexed a -> Indexed a -> Bool
$c/= :: forall a. Indexed a -> Indexed a -> Bool
/= :: Indexed a -> Indexed a -> Bool
Eq, Eq (Indexed a)
Eq (Indexed a) =>
(Indexed a -> Indexed a -> Ordering)
-> (Indexed a -> Indexed a -> Bool)
-> (Indexed a -> Indexed a -> Bool)
-> (Indexed a -> Indexed a -> Bool)
-> (Indexed a -> Indexed a -> Bool)
-> (Indexed a -> Indexed a -> Indexed a)
-> (Indexed a -> Indexed a -> Indexed a)
-> Ord (Indexed a)
Indexed a -> Indexed a -> Bool
Indexed a -> Indexed a -> Ordering
Indexed a -> Indexed a -> Indexed a
forall a. Eq (Indexed a)
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
forall a. Indexed a -> Indexed a -> Bool
forall a. Indexed a -> Indexed a -> Ordering
forall a. Indexed a -> Indexed a -> Indexed a
$ccompare :: forall a. Indexed a -> Indexed a -> Ordering
compare :: Indexed a -> Indexed a -> Ordering
$c< :: forall a. Indexed a -> Indexed a -> Bool
< :: Indexed a -> Indexed a -> Bool
$c<= :: forall a. Indexed a -> Indexed a -> Bool
<= :: Indexed a -> Indexed a -> Bool
$c> :: forall a. Indexed a -> Indexed a -> Bool
> :: Indexed a -> Indexed a -> Bool
$c>= :: forall a. Indexed a -> Indexed a -> Bool
>= :: Indexed a -> Indexed a -> Bool
$cmax :: forall a. Indexed a -> Indexed a -> Indexed a
max :: Indexed a -> Indexed a -> Indexed a
$cmin :: forall a. Indexed a -> Indexed a -> Indexed a
min :: Indexed a -> Indexed a -> Indexed a
Ord, (forall a b. (a -> b) -> Indexed a -> Indexed b)
-> (forall a b. a -> Indexed b -> Indexed a) -> Functor Indexed
forall a b. a -> Indexed b -> Indexed a
forall a b. (a -> b) -> Indexed a -> Indexed b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Indexed a -> Indexed b
fmap :: forall a b. (a -> b) -> Indexed a -> Indexed b
$c<$ :: forall a b. a -> Indexed b -> Indexed a
<$ :: forall a b. a -> Indexed b -> Indexed a
Functor, Int -> Indexed a -> ShowS
[Indexed a] -> ShowS
Indexed a -> String
(Int -> Indexed a -> ShowS)
-> (Indexed a -> String)
-> ([Indexed a] -> ShowS)
-> Show (Indexed a)
forall a. Int -> Indexed a -> ShowS
forall a. [Indexed a] -> ShowS
forall a. Indexed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Indexed a -> ShowS
showsPrec :: Int -> Indexed a -> ShowS
$cshow :: forall a. Indexed a -> String
show :: Indexed a -> String
$cshowList :: forall a. [Indexed a] -> ShowS
showList :: [Indexed a] -> ShowS
Show, ReadPrec [Indexed a]
ReadPrec (Indexed a)
Int -> ReadS (Indexed a)
ReadS [Indexed a]
(Int -> ReadS (Indexed a))
-> ReadS [Indexed a]
-> ReadPrec (Indexed a)
-> ReadPrec [Indexed a]
-> Read (Indexed a)
forall a. ReadPrec [Indexed a]
forall a. ReadPrec (Indexed a)
forall a. Int -> ReadS (Indexed a)
forall a. ReadS [Indexed a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (Indexed a)
readsPrec :: Int -> ReadS (Indexed a)
$creadList :: forall a. ReadS [Indexed a]
readList :: ReadS [Indexed a]
$creadPrec :: forall a. ReadPrec (Indexed a)
readPrec :: ReadPrec (Indexed a)
$creadListPrec :: forall a. ReadPrec [Indexed a]
readListPrec :: ReadPrec [Indexed a]
Read)

instance Show1 Indexed where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Indexed a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
p (Indexed Int
i) String
s = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Int
i String
s

instance Eq1 Indexed where
  liftEq :: forall a b. (a -> b -> Bool) -> Indexed a -> Indexed b -> Bool
liftEq a -> b -> Bool
_ (Indexed Int
i) (Indexed Int
j) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j

data SiphonError = SiphonError
  { SiphonError -> Int
siphonErrorRow :: !Int
  , SiphonError -> RowError
siphonErrorCause :: !RowError
  }
  deriving (Int -> SiphonError -> ShowS
[SiphonError] -> ShowS
SiphonError -> String
(Int -> SiphonError -> ShowS)
-> (SiphonError -> String)
-> ([SiphonError] -> ShowS)
-> Show SiphonError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SiphonError -> ShowS
showsPrec :: Int -> SiphonError -> ShowS
$cshow :: SiphonError -> String
show :: SiphonError -> String
$cshowList :: [SiphonError] -> ShowS
showList :: [SiphonError] -> ShowS
Show, ReadPrec [SiphonError]
ReadPrec SiphonError
Int -> ReadS SiphonError
ReadS [SiphonError]
(Int -> ReadS SiphonError)
-> ReadS [SiphonError]
-> ReadPrec SiphonError
-> ReadPrec [SiphonError]
-> Read SiphonError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SiphonError
readsPrec :: Int -> ReadS SiphonError
$creadList :: ReadS [SiphonError]
readList :: ReadS [SiphonError]
$creadPrec :: ReadPrec SiphonError
readPrec :: ReadPrec SiphonError
$creadListPrec :: ReadPrec [SiphonError]
readListPrec :: ReadPrec [SiphonError]
Read, SiphonError -> SiphonError -> Bool
(SiphonError -> SiphonError -> Bool)
-> (SiphonError -> SiphonError -> Bool) -> Eq SiphonError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SiphonError -> SiphonError -> Bool
== :: SiphonError -> SiphonError -> Bool
$c/= :: SiphonError -> SiphonError -> Bool
/= :: SiphonError -> SiphonError -> Bool
Eq)

instance Exception SiphonError

data RowError
  = -- | Error occurred parsing the document into cells
    RowErrorParse
  | -- | Error decoding the content
    RowErrorDecode !(Vector CellError)
  | -- | Wrong number of cells in the row
    RowErrorSize !Int !Int
  | -- | Three parts:
    --   (a) Multiple header cells matched the same expected cell,
    --   (b) Headers that were missing,
    --   (c) Missing headers that were lambdas. They cannot be
    --   shown so instead their positions in the 'Siphon' are given.
    RowErrorHeaders !(Vector (Vector CellError)) !(Vector Text) !(Vector Int)
  | -- | Not enough cells in header, expected, actual
    RowErrorHeaderSize !Int !Int
  | -- | Error decoding unicode content, column number
    RowErrorMalformed !Int
  deriving (Int -> RowError -> ShowS
[RowError] -> ShowS
RowError -> String
(Int -> RowError -> ShowS)
-> (RowError -> String) -> ([RowError] -> ShowS) -> Show RowError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowError -> ShowS
showsPrec :: Int -> RowError -> ShowS
$cshow :: RowError -> String
show :: RowError -> String
$cshowList :: [RowError] -> ShowS
showList :: [RowError] -> ShowS
Show, ReadPrec [RowError]
ReadPrec RowError
Int -> ReadS RowError
ReadS [RowError]
(Int -> ReadS RowError)
-> ReadS [RowError]
-> ReadPrec RowError
-> ReadPrec [RowError]
-> Read RowError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RowError
readsPrec :: Int -> ReadS RowError
$creadList :: ReadS [RowError]
readList :: ReadS [RowError]
$creadPrec :: ReadPrec RowError
readPrec :: ReadPrec RowError
$creadListPrec :: ReadPrec [RowError]
readListPrec :: ReadPrec [RowError]
Read, RowError -> RowError -> Bool
(RowError -> RowError -> Bool)
-> (RowError -> RowError -> Bool) -> Eq RowError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowError -> RowError -> Bool
== :: RowError -> RowError -> Bool
$c/= :: RowError -> RowError -> Bool
/= :: RowError -> RowError -> Bool
Eq)

{- | This just actually a specialization of the free applicative.
  Check out @Control.Applicative.Free@ in the @free@ library to
  learn more about this. The meanings of the fields are documented
  slightly more in the source code. Unfortunately, haddock does not
  play nicely with GADTs.
-}
data Siphon f c a where
  SiphonPure ::
    !a -> -- function
    Siphon f c a
  SiphonAp ::
    !(f c) -> -- header
    !(c -> Maybe a) -> -- decoding function
    !(Siphon f c (a -> b)) -> -- next decoding
    Siphon f c b

instance Functor (Siphon f c) where
  fmap :: forall a b. (a -> b) -> Siphon f c a -> Siphon f c b
fmap a -> b
f (SiphonPure a
a) = b -> Siphon f c b
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure (a -> b
f a
a)
  fmap a -> b
f (SiphonAp f c
h c -> Maybe a
c Siphon f c (a -> a)
apNext) = f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp f c
h c -> Maybe a
c ((a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> a) -> a -> b) -> Siphon f c (a -> a) -> Siphon f c (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Siphon f c (a -> a)
apNext)

instance Applicative (Siphon f c) where
  pure :: forall a. a -> Siphon f c a
pure = a -> Siphon f c a
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure
  SiphonPure a -> b
f <*> :: forall a b. Siphon f c (a -> b) -> Siphon f c a -> Siphon f c b
<*> Siphon f c a
y = (a -> b) -> Siphon f c a -> Siphon f c b
forall a b. (a -> b) -> Siphon f c a -> Siphon f c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Siphon f c a
y
  SiphonAp f c
h c -> Maybe a
c Siphon f c (a -> a -> b)
y <*> Siphon f c a
z = f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp f c
h c -> Maybe a
c ((a -> a -> b) -> a -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> b) -> a -> a -> b)
-> Siphon f c (a -> a -> b) -> Siphon f c (a -> a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Siphon f c (a -> a -> b)
y Siphon f c (a -> a -> b) -> Siphon f c a -> Siphon f c (a -> b)
forall a b. Siphon f c (a -> b) -> Siphon f c a -> Siphon f c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Siphon f c a
z)