{-# language DisambiguateRecordFields #-}
{-# language StandaloneKindSignatures #-}
{-# language OverloadedStrings #-}
{-# language TypeApplications #-}

module Rel8.Type.JSONEncoded (
  JSONEncoded(..),
) where

-- aeson
import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, parseJSON, toJSON)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson
import Data.Aeson.Types (parseEither)

-- base
import Data.Bifunctor (first)
import Data.Functor.Contravariant ((>$<))
import Data.Kind ( Type )
import Prelude

-- hasql
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders

-- rel8
import Rel8.Type ( DBType(..) )
import Rel8.Type.Decoder (Decoder (..))
import Rel8.Type.Encoder (Encoder (..))
import Rel8.Type.Information ( TypeInformation(..) )

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )

-- text
import Data.Text (pack)
import Data.Text.Lazy (unpack)


-- | A deriving-via helper type for column types that store a Haskell value
-- using a JSON encoding described by @aeson@'s 'ToJSON' and 'FromJSON' type
-- classes.
type JSONEncoded :: Type -> Type
newtype JSONEncoded a = JSONEncoded { forall a. JSONEncoded a -> a
fromJSONEncoded :: a }
  deriving (Int -> JSONEncoded a -> ShowS
[JSONEncoded a] -> ShowS
JSONEncoded a -> String
(Int -> JSONEncoded a -> ShowS)
-> (JSONEncoded a -> String)
-> ([JSONEncoded a] -> ShowS)
-> Show (JSONEncoded a)
forall a. Show a => Int -> JSONEncoded a -> ShowS
forall a. Show a => [JSONEncoded a] -> ShowS
forall a. Show a => JSONEncoded a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JSONEncoded a -> ShowS
showsPrec :: Int -> JSONEncoded a -> ShowS
$cshow :: forall a. Show a => JSONEncoded a -> String
show :: JSONEncoded a -> String
$cshowList :: forall a. Show a => [JSONEncoded a] -> ShowS
showList :: [JSONEncoded a] -> ShowS
Show, JSONEncoded a -> JSONEncoded a -> Bool
(JSONEncoded a -> JSONEncoded a -> Bool)
-> (JSONEncoded a -> JSONEncoded a -> Bool) -> Eq (JSONEncoded a)
forall a. Eq a => JSONEncoded a -> JSONEncoded a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => JSONEncoded a -> JSONEncoded a -> Bool
== :: JSONEncoded a -> JSONEncoded a -> Bool
$c/= :: forall a. Eq a => JSONEncoded a -> JSONEncoded a -> Bool
/= :: JSONEncoded a -> JSONEncoded a -> Bool
Eq, Eq (JSONEncoded a)
Eq (JSONEncoded a) =>
(JSONEncoded a -> JSONEncoded a -> Ordering)
-> (JSONEncoded a -> JSONEncoded a -> Bool)
-> (JSONEncoded a -> JSONEncoded a -> Bool)
-> (JSONEncoded a -> JSONEncoded a -> Bool)
-> (JSONEncoded a -> JSONEncoded a -> Bool)
-> (JSONEncoded a -> JSONEncoded a -> JSONEncoded a)
-> (JSONEncoded a -> JSONEncoded a -> JSONEncoded a)
-> Ord (JSONEncoded a)
JSONEncoded a -> JSONEncoded a -> Bool
JSONEncoded a -> JSONEncoded a -> Ordering
JSONEncoded a -> JSONEncoded a -> JSONEncoded 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. Ord a => Eq (JSONEncoded a)
forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Bool
forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Ordering
forall a. Ord a => JSONEncoded a -> JSONEncoded a -> JSONEncoded a
$ccompare :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Ordering
compare :: JSONEncoded a -> JSONEncoded a -> Ordering
$c< :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Bool
< :: JSONEncoded a -> JSONEncoded a -> Bool
$c<= :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Bool
<= :: JSONEncoded a -> JSONEncoded a -> Bool
$c> :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Bool
> :: JSONEncoded a -> JSONEncoded a -> Bool
$c>= :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> Bool
>= :: JSONEncoded a -> JSONEncoded a -> Bool
$cmax :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> JSONEncoded a
max :: JSONEncoded a -> JSONEncoded a -> JSONEncoded a
$cmin :: forall a. Ord a => JSONEncoded a -> JSONEncoded a -> JSONEncoded a
min :: JSONEncoded a -> JSONEncoded a -> JSONEncoded a
Ord)


instance (FromJSON a, ToJSON a) => DBType (JSONEncoded a) where
  typeInformation :: TypeInformation (JSONEncoded a)
typeInformation = TypeInformation
    { encode :: Encoder (JSONEncoded a)
encode =
        Encoder
          { binary :: Value (JSONEncoded a)
binary = a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> (JSONEncoded a -> a) -> JSONEncoded a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONEncoded a -> a
forall a. JSONEncoded a -> a
fromJSONEncoded (JSONEncoded a -> Value) -> Value Value -> Value (JSONEncoded a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value Value
Encoders.json
          , text :: JSONEncoded a -> Builder
text = Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
Aeson.fromEncoding (Encoding' Value -> Builder)
-> (JSONEncoded a -> Encoding' Value) -> JSONEncoded a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
Aeson.toEncoding (a -> Encoding' Value)
-> (JSONEncoded a -> a) -> JSONEncoded a -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONEncoded a -> a
forall a. JSONEncoded a -> a
fromJSONEncoded
          , quote :: JSONEncoded a -> PrimExpr
quote =
              Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (JSONEncoded a -> Literal) -> JSONEncoded a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal)
-> (JSONEncoded a -> String) -> JSONEncoded a -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Opaleye.quote ShowS -> (JSONEncoded a -> String) -> JSONEncoded a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              Text -> String
unpack (Text -> String)
-> (JSONEncoded a -> Text) -> JSONEncoded a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText (a -> Text) -> (JSONEncoded a -> a) -> JSONEncoded a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONEncoded a -> a
forall a. JSONEncoded a -> a
fromJSONEncoded
          }
    , decode :: Decoder (JSONEncoded a)
decode =
        Decoder
          { binary :: Value (JSONEncoded a)
binary =
              (Value -> Either Text (JSONEncoded a))
-> Value Value -> Value (JSONEncoded a)
forall a b. (a -> Either Text b) -> Value a -> Value b
Decoders.refine
                ((String -> Text)
-> Either String (JSONEncoded a) -> Either Text (JSONEncoded a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String (JSONEncoded a) -> Either Text (JSONEncoded a))
-> (Value -> Either String (JSONEncoded a))
-> Value
-> Either Text (JSONEncoded a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JSONEncoded a)
-> Either String a -> Either String (JSONEncoded a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JSONEncoded a
forall a. a -> JSONEncoded a
JSONEncoded (Either String a -> Either String (JSONEncoded a))
-> (Value -> Either String a)
-> Value
-> Either String (JSONEncoded a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)
                Value Value
Decoders.json
          , text :: Parser (JSONEncoded a)
text = (a -> JSONEncoded a)
-> Either String a -> Either String (JSONEncoded a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> JSONEncoded a
forall a. a -> JSONEncoded a
JSONEncoded (Either String a -> Either String (JSONEncoded a))
-> (ByteString -> Either String a) -> Parser (JSONEncoded a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict
          }
    , delimiter :: Char
delimiter = Char
','
    , typeName :: TypeName
typeName = TypeName
"json"
    }