{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module PostgreSQL.Result.Cell
( Cell (..)
, ignored
, raw
, text
, readable
, validate
)
where
import Control.Monad ((>=>))
import Control.Monad.Except (Except, ExceptT (..))
import Control.Monad.Reader (ReaderT (..))
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.Functor.Alt (Alt (..))
import Data.Functor.Identity (Identity (..))
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8')
import PostgreSQL.Types (Value (..))
import Text.Read (readEither)
newtype Cell a = Cell
{ Cell a -> Value -> Either (NonEmpty Text) a
parseCell :: Value -> Either (NonEmpty Text) a }
deriving stock Functor
deriving via ReaderT Value (Except (NonEmpty Text)) instance Alt Cell
ignored :: Cell ()
ignored :: Cell ()
ignored = (Value -> Either (NonEmpty Text) ()) -> Cell ()
forall a. (Value -> Either (NonEmpty Text) a) -> Cell a
Cell ((Value -> Either (NonEmpty Text) ()) -> Cell ())
-> (Value -> Either (NonEmpty Text) ()) -> Cell ()
forall a b. (a -> b) -> a -> b
$ \Value
_ -> () -> Either (NonEmpty Text) ()
forall a b. b -> Either a b
Right ()
{-# INLINE ignored #-}
raw :: Cell ByteString
raw :: Cell ByteString
raw = (Value -> Either (NonEmpty Text) ByteString) -> Cell ByteString
forall a. (Value -> Either (NonEmpty Text) a) -> Cell a
Cell ((Value -> Either (NonEmpty Text) ByteString) -> Cell ByteString)
-> (Value -> Either (NonEmpty Text) ByteString) -> Cell ByteString
forall a b. (a -> b) -> a -> b
$ \case
Value
Null -> NonEmpty Text -> Either (NonEmpty Text) ByteString
forall a b. a -> Either a b
Left [Item (NonEmpty Text)
"Can't be NULL"]
Value ByteString
encoded -> ByteString -> Either (NonEmpty Text) ByteString
forall a b. b -> Either a b
Right ByteString
encoded
{-# INLINE raw #-}
text :: Cell Text
text :: Cell Text
text = Cell ByteString -> (ByteString -> Either Text Text) -> Cell Text
forall a b. Cell a -> (a -> Either Text b) -> Cell b
validate Cell ByteString
raw ((UnicodeException -> Text)
-> Either UnicodeException Text -> Either Text Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
Text.pack (String -> Text)
-> (UnicodeException -> String) -> UnicodeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall a. Show a => a -> String
show) (Either UnicodeException Text -> Either Text Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8')
{-# INLINE text #-}
readable :: Read a => Cell a
readable :: Cell a
readable = Cell Text -> (Text -> Either Text a) -> Cell a
forall a b. Cell a -> (a -> Either Text b) -> Cell b
validate Cell Text
text ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
Text.pack (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEither (String -> Either String a)
-> (Text -> String) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
{-# INLINE readable #-}
validate :: Cell a -> (a -> Either Text b) -> Cell b
validate :: Cell a -> (a -> Either Text b) -> Cell b
validate (Cell Value -> Either (NonEmpty Text) a
run) a -> Either Text b
f = (Value -> Either (NonEmpty Text) b) -> Cell b
forall a. (Value -> Either (NonEmpty Text) a) -> Cell a
Cell (Value -> Either (NonEmpty Text) a
run (Value -> Either (NonEmpty Text) a)
-> (a -> Either (NonEmpty Text) b)
-> Value
-> Either (NonEmpty Text) b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> NonEmpty Text)
-> Either Text b -> Either (NonEmpty Text) b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text b -> Either (NonEmpty Text) b)
-> (a -> Either Text b) -> a -> Either (NonEmpty Text) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either Text b
f)
{-# INLINE validate #-}