{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Binrep.Type.Text.Encoding.Ascii where

import Binrep.Type.Text.Internal
import Binrep.Type.Text.Encoding.Utf8

import Refined
import Data.Typeable ( typeRep )

import Data.Char qualified as Char
import Data.Text qualified as Text
import Data.Text ( Text )

import Data.Text.Encoding qualified as Text
import Control.Exception qualified
import System.IO.Unsafe qualified

-- | 7-bit
data Ascii

-- | We reuse UTF-8 encoding for ASCII, since it is a subset of UTF-8.
instance Encode Ascii where encode' :: Text -> Bytes
encode' = forall enc. Encode enc => Text -> Bytes
forall {k} (enc :: k). Encode enc => Text -> Bytes
encode' @Utf8

-- Pre-@text-2.0@, @decodeASCII@ generated a warning and ran @decodeUtf8@.
-- TODO can I give some compile time warning about this instance missing on
-- below text-2.0?? would be cool
#if MIN_VERSION_text(2,0,0)
-- TODO 2023-01-26 raehik: awful UX by text. hopefully safe lol?? works at least
instance Decode Ascii where decode :: Bytes -> Either String (AsText Ascii)
decode = (String -> String)
-> (Bytes -> Either String Text)
-> Bytes
-> Either String (AsText Ascii)
forall {k} (enc :: k) e.
(e -> String)
-> (Bytes -> Either e Text) -> Bytes -> Either String (AsText enc)
decodeText String -> String
forall a. a -> a
id ((Bytes -> Either String Text)
 -> Bytes -> Either String (AsText Ascii))
-> (Bytes -> Either String Text)
-> Bytes
-> Either String (AsText Ascii)
forall a b. (a -> b) -> a -> b
$ (Bytes -> Text) -> Bytes -> Either String Text
forall a b. (a -> b) -> a -> Either String b
catchErrorCall Bytes -> Text
Text.decodeASCII
#endif

catchErrorCall :: (a -> b) -> a -> Either String b
catchErrorCall :: forall a b. (a -> b) -> a -> Either String b
catchErrorCall a -> b
f a
a = IO (Either String b) -> Either String b
forall a. IO a -> a
System.IO.Unsafe.unsafeDupablePerformIO (IO (Either String b) -> Either String b)
-> IO (Either String b) -> Either String b
forall a b. (a -> b) -> a -> b
$ do
    forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try @Control.Exception.ErrorCall (b -> IO b
forall a. a -> IO a
Control.Exception.evaluate (a -> b
f a
a)) IO (Either ErrorCall b)
-> (Either ErrorCall b -> IO (Either String b))
-> IO (Either String b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right b
b -> Either String b -> IO (Either String b)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ b -> Either String b
forall a b. b -> Either a b
Right b
b
      Left  (Control.Exception.ErrorCallWithLocation String
msg String
_) -> Either String b -> IO (Either String b)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left String
msg

-- | 'Text' must be validated if you want to permit 7-bit ASCII only.
--
-- TODO there should be a MUCH faster check here in text-2.0. text-short has it,
-- text doesn't yet. see: https://github.com/haskell/text/issues/496
instance Predicate Ascii Text where
    validate :: Proxy Ascii -> Text -> Maybe RefineException
validate Proxy Ascii
p Text
t = if   (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isAscii Text
t
                   then Maybe RefineException
success
                   else TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (Proxy Ascii -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy Ascii
p) Text
"not valid 7-bit ASCII"