module Colonnade.Types
( Encoding(..)
, Decoding(..)
, OneEncoding(..)
, Headed(..)
, Headless(..)
, Indexed(..)
, HeadingErrors(..)
, DecodingCellError(..)
, DecodingRowError(..)
, DecodingCellErrors(..)
, RowError(..)
) where
import Data.Vector (Vector)
import Data.Functor.Contravariant (Contravariant(..))
import Data.Functor.Contravariant.Divisible (Divisible(..))
import Control.Exception (Exception)
import Data.Typeable (Typeable)
import qualified Data.Vector as Vector
newtype Headed a = Headed { getHeaded :: a }
deriving (Eq,Ord,Functor,Show,Read,Foldable)
data Headless a = Headless
deriving (Eq,Ord,Functor,Show,Read,Foldable)
data Indexed f a = Indexed
{ indexedIndex :: !Int
, indexedHeading :: !(f a)
} deriving (Eq,Ord,Functor,Show,Read)
data HeadingErrors content = HeadingErrors
{ headingErrorsMissing :: Vector content
, headingErrorsDuplicate :: Vector (content,Int)
} deriving (Show,Read,Eq)
instance (Show content, Typeable content) => Exception (HeadingErrors content)
instance Monoid (HeadingErrors content) where
mempty = HeadingErrors Vector.empty Vector.empty
mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors
(a1 Vector.++ a2) (b1 Vector.++ b2)
data DecodingCellError f content = DecodingCellError
{ decodingCellErrorContent :: !content
, decodingCellErrorHeader :: !(Indexed f content)
, decodingCellErrorMessage :: !String
} deriving (Show,Read,Eq)
newtype DecodingCellErrors f content = DecodingCellErrors
{ getDecodingCellErrors :: Vector (DecodingCellError f content)
} deriving (Monoid,Show,Read,Eq)
data DecodingRowError f content = DecodingRowError
{ decodingRowErrorRow :: !Int
, decodingRowErrorError :: !(RowError f content)
} deriving (Show,Read,Eq)
data RowError f content
= RowErrorParse !String
| RowErrorDecode !(DecodingCellErrors f content)
| RowErrorSize !Int !Int
| RowErrorHeading !(HeadingErrors content)
| RowErrorMinSize !Int !Int
| RowErrorMalformed !String
deriving (Show,Read,Eq)
instance Contravariant Headless where
contramap _ Headless = Headless
data Decoding f content a where
DecodingPure :: !a
-> Decoding f content a
DecodingAp :: !(f content)
-> !(content -> Either String a)
-> !(Decoding f content (a -> b))
-> Decoding f content b
instance Functor (Decoding f content) where
fmap f (DecodingPure a) = DecodingPure (f a)
fmap f (DecodingAp h c apNext) = DecodingAp h c ((f .) <$> apNext)
instance Applicative (Decoding f content) where
pure = DecodingPure
DecodingPure f <*> y = fmap f y
DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z)
data OneEncoding f content a = OneEncoding
{ oneEncodingHead :: !(f content)
, oneEncodingEncode :: !(a -> content)
}
instance Contravariant (OneEncoding f content) where
contramap f (OneEncoding h e) = OneEncoding h (e . f)
newtype Encoding f content a = Encoding
{ getEncoding :: Vector (OneEncoding f content a)
} deriving (Monoid)
instance Contravariant (Encoding f content) where
contramap f (Encoding v) = Encoding
(Vector.map (contramap f) v)
instance Divisible (Encoding f content) where
conquer = Encoding Vector.empty
divide f (Encoding a) (Encoding b) =
Encoding $ (Vector.++)
(Vector.map (contramap (fst . f)) a)
(Vector.map (contramap (snd . f)) b)