{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TypeApplications #-}

module Dep.Value.Text (
    -- * Construct 'Text' 'Value's.

    fromUtf8,
    TextValueDecodeError (..)
) where

import Data.Typeable
import Data.ByteString
import Dep.Value
import Control.Exception
import Data.Text
import Data.Text.Encoding (decodeUtf8')
import Data.Text.Encoding.Error

fromUtf8 ::
  forall v m.
  ( 
    Typeable v,
    Monad m
  ) =>
  (Text -> v) ->
  m ByteString ->
  Value v m
fromUtf8 :: (Text -> v) -> m ByteString -> Value v m
fromUtf8 Text -> v
ctor m ByteString
action = m v -> Value v m
forall v (m :: * -> *). m v -> Value v m
Value do
  ByteString
bytes <- m ByteString
action
  case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bytes of
    Left UnicodeException
uex -> TextValueDecodeError -> m v
forall a e. Exception e => e -> a
throw (TypeRep -> UnicodeException -> TextValueDecodeError
TextValueDecodeError (Proxy v -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy v
forall k (t :: k). Proxy t
Proxy @v)) UnicodeException
uex)
    Right Text
v -> v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> v
ctor Text
v)

data TextValueDecodeError = TextValueDecodeError TypeRep UnicodeException deriving (Int -> TextValueDecodeError -> ShowS
[TextValueDecodeError] -> ShowS
TextValueDecodeError -> String
(Int -> TextValueDecodeError -> ShowS)
-> (TextValueDecodeError -> String)
-> ([TextValueDecodeError] -> ShowS)
-> Show TextValueDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextValueDecodeError] -> ShowS
$cshowList :: [TextValueDecodeError] -> ShowS
show :: TextValueDecodeError -> String
$cshow :: TextValueDecodeError -> String
showsPrec :: Int -> TextValueDecodeError -> ShowS
$cshowsPrec :: Int -> TextValueDecodeError -> ShowS
Show)

instance Exception TextValueDecodeError