{-# LANGUAGE DeriveFoldable         #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
-- | Types and functions for handling escaped characters in JSON.
module Waargonaut.Types.JChar.Escaped
  (
    -- * Types
    Escaped (..)
  , AsEscaped (..)

    -- * Parser
  , parseEscaped

    -- * Conversion
  , escapedToChar
  , charToEscaped
  ) where

import           Prelude                          (Eq, Ord, Show)

import           Control.Applicative              (pure, (*>), (<|>))
import           Control.Category                 (id, (.))

import           Control.Lens                     (Prism', preview, prism, to,
                                                   _Just)

import           Data.Foldable                    (Foldable, asum)
import           Data.Functor                     (Functor, (<$>))
import           Data.Traversable                 (Traversable)

import           Data.Function                    (const)

import           Data.Char                        (Char)
import           Data.Either                      (Either (..))
import           Data.Maybe                       (Maybe (..))

import           Data.Digit                       (HeXDigit, HeXaDeCiMaL)

import           Text.Parser.Char                 (CharParsing, char)

import           Waargonaut.Types.JChar.HexDigit4 (HexDigit4, charToHexDigit4,
                                                   hexDigit4ToChar,
                                                   parseHexDigit4)
import           Waargonaut.Types.Whitespace      (Whitespace (..),
                                                   escapedWhitespaceChar,
                                                   _WhitespaceChar)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Monad (return)
-- >>> import Data.Either(Either (..), isLeft)
-- >>> import Data.Digit (HeXDigit(..))
-- >>> import qualified Data.Digit as D
-- >>> import Waargonaut.Decode.Error (DecodeError)
-- >>> import Utils
----

-- | Things that may be escaped in a JSON string.
data Escaped digit
  = QuotationMark
  | ReverseSolidus
  | Solidus
  | Backspace
  | WhiteSpace Whitespace
  | Hex ( HexDigit4 digit )
  deriving (Escaped digit -> Escaped digit -> Bool
(Escaped digit -> Escaped digit -> Bool)
-> (Escaped digit -> Escaped digit -> Bool) -> Eq (Escaped digit)
forall digit. Eq digit => Escaped digit -> Escaped digit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Escaped digit -> Escaped digit -> Bool
$c/= :: forall digit. Eq digit => Escaped digit -> Escaped digit -> Bool
== :: Escaped digit -> Escaped digit -> Bool
$c== :: forall digit. Eq digit => Escaped digit -> Escaped digit -> Bool
Eq, Eq (Escaped digit)
Eq (Escaped digit)
-> (Escaped digit -> Escaped digit -> Ordering)
-> (Escaped digit -> Escaped digit -> Bool)
-> (Escaped digit -> Escaped digit -> Bool)
-> (Escaped digit -> Escaped digit -> Bool)
-> (Escaped digit -> Escaped digit -> Bool)
-> (Escaped digit -> Escaped digit -> Escaped digit)
-> (Escaped digit -> Escaped digit -> Escaped digit)
-> Ord (Escaped digit)
Escaped digit -> Escaped digit -> Bool
Escaped digit -> Escaped digit -> Ordering
Escaped digit -> Escaped digit -> Escaped digit
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 digit. Ord digit => Eq (Escaped digit)
forall digit. Ord digit => Escaped digit -> Escaped digit -> Bool
forall digit.
Ord digit =>
Escaped digit -> Escaped digit -> Ordering
forall digit.
Ord digit =>
Escaped digit -> Escaped digit -> Escaped digit
min :: Escaped digit -> Escaped digit -> Escaped digit
$cmin :: forall digit.
Ord digit =>
Escaped digit -> Escaped digit -> Escaped digit
max :: Escaped digit -> Escaped digit -> Escaped digit
$cmax :: forall digit.
Ord digit =>
Escaped digit -> Escaped digit -> Escaped digit
>= :: Escaped digit -> Escaped digit -> Bool
$c>= :: forall digit. Ord digit => Escaped digit -> Escaped digit -> Bool
> :: Escaped digit -> Escaped digit -> Bool
$c> :: forall digit. Ord digit => Escaped digit -> Escaped digit -> Bool
<= :: Escaped digit -> Escaped digit -> Bool
$c<= :: forall digit. Ord digit => Escaped digit -> Escaped digit -> Bool
< :: Escaped digit -> Escaped digit -> Bool
$c< :: forall digit. Ord digit => Escaped digit -> Escaped digit -> Bool
compare :: Escaped digit -> Escaped digit -> Ordering
$ccompare :: forall digit.
Ord digit =>
Escaped digit -> Escaped digit -> Ordering
$cp1Ord :: forall digit. Ord digit => Eq (Escaped digit)
Ord, Int -> Escaped digit -> ShowS
[Escaped digit] -> ShowS
Escaped digit -> String
(Int -> Escaped digit -> ShowS)
-> (Escaped digit -> String)
-> ([Escaped digit] -> ShowS)
-> Show (Escaped digit)
forall digit. Show digit => Int -> Escaped digit -> ShowS
forall digit. Show digit => [Escaped digit] -> ShowS
forall digit. Show digit => Escaped digit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Escaped digit] -> ShowS
$cshowList :: forall digit. Show digit => [Escaped digit] -> ShowS
show :: Escaped digit -> String
$cshow :: forall digit. Show digit => Escaped digit -> String
showsPrec :: Int -> Escaped digit -> ShowS
$cshowsPrec :: forall digit. Show digit => Int -> Escaped digit -> ShowS
Show, a -> Escaped b -> Escaped a
(a -> b) -> Escaped a -> Escaped b
(forall a b. (a -> b) -> Escaped a -> Escaped b)
-> (forall a b. a -> Escaped b -> Escaped a) -> Functor Escaped
forall a b. a -> Escaped b -> Escaped a
forall a b. (a -> b) -> Escaped a -> Escaped b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Escaped b -> Escaped a
$c<$ :: forall a b. a -> Escaped b -> Escaped a
fmap :: (a -> b) -> Escaped a -> Escaped b
$cfmap :: forall a b. (a -> b) -> Escaped a -> Escaped b
Functor, Escaped a -> Bool
(a -> m) -> Escaped a -> m
(a -> b -> b) -> b -> Escaped a -> b
(forall m. Monoid m => Escaped m -> m)
-> (forall m a. Monoid m => (a -> m) -> Escaped a -> m)
-> (forall m a. Monoid m => (a -> m) -> Escaped a -> m)
-> (forall a b. (a -> b -> b) -> b -> Escaped a -> b)
-> (forall a b. (a -> b -> b) -> b -> Escaped a -> b)
-> (forall b a. (b -> a -> b) -> b -> Escaped a -> b)
-> (forall b a. (b -> a -> b) -> b -> Escaped a -> b)
-> (forall a. (a -> a -> a) -> Escaped a -> a)
-> (forall a. (a -> a -> a) -> Escaped a -> a)
-> (forall a. Escaped a -> [a])
-> (forall a. Escaped a -> Bool)
-> (forall a. Escaped a -> Int)
-> (forall a. Eq a => a -> Escaped a -> Bool)
-> (forall a. Ord a => Escaped a -> a)
-> (forall a. Ord a => Escaped a -> a)
-> (forall a. Num a => Escaped a -> a)
-> (forall a. Num a => Escaped a -> a)
-> Foldable Escaped
forall a. Eq a => a -> Escaped a -> Bool
forall a. Num a => Escaped a -> a
forall a. Ord a => Escaped a -> a
forall m. Monoid m => Escaped m -> m
forall a. Escaped a -> Bool
forall a. Escaped a -> Int
forall a. Escaped a -> [a]
forall a. (a -> a -> a) -> Escaped a -> a
forall m a. Monoid m => (a -> m) -> Escaped a -> m
forall b a. (b -> a -> b) -> b -> Escaped a -> b
forall a b. (a -> b -> b) -> b -> Escaped a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Escaped a -> a
$cproduct :: forall a. Num a => Escaped a -> a
sum :: Escaped a -> a
$csum :: forall a. Num a => Escaped a -> a
minimum :: Escaped a -> a
$cminimum :: forall a. Ord a => Escaped a -> a
maximum :: Escaped a -> a
$cmaximum :: forall a. Ord a => Escaped a -> a
elem :: a -> Escaped a -> Bool
$celem :: forall a. Eq a => a -> Escaped a -> Bool
length :: Escaped a -> Int
$clength :: forall a. Escaped a -> Int
null :: Escaped a -> Bool
$cnull :: forall a. Escaped a -> Bool
toList :: Escaped a -> [a]
$ctoList :: forall a. Escaped a -> [a]
foldl1 :: (a -> a -> a) -> Escaped a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Escaped a -> a
foldr1 :: (a -> a -> a) -> Escaped a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Escaped a -> a
foldl' :: (b -> a -> b) -> b -> Escaped a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Escaped a -> b
foldl :: (b -> a -> b) -> b -> Escaped a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Escaped a -> b
foldr' :: (a -> b -> b) -> b -> Escaped a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Escaped a -> b
foldr :: (a -> b -> b) -> b -> Escaped a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Escaped a -> b
foldMap' :: (a -> m) -> Escaped a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Escaped a -> m
foldMap :: (a -> m) -> Escaped a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Escaped a -> m
fold :: Escaped m -> m
$cfold :: forall m. Monoid m => Escaped m -> m
Foldable, Functor Escaped
Foldable Escaped
Functor Escaped
-> Foldable Escaped
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Escaped a -> f (Escaped b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Escaped (f a) -> f (Escaped a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Escaped a -> m (Escaped b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Escaped (m a) -> m (Escaped a))
-> Traversable Escaped
(a -> f b) -> Escaped a -> f (Escaped b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Escaped (m a) -> m (Escaped a)
forall (f :: * -> *) a.
Applicative f =>
Escaped (f a) -> f (Escaped a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Escaped a -> m (Escaped b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Escaped a -> f (Escaped b)
sequence :: Escaped (m a) -> m (Escaped a)
$csequence :: forall (m :: * -> *) a. Monad m => Escaped (m a) -> m (Escaped a)
mapM :: (a -> m b) -> Escaped a -> m (Escaped b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Escaped a -> m (Escaped b)
sequenceA :: Escaped (f a) -> f (Escaped a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Escaped (f a) -> f (Escaped a)
traverse :: (a -> f b) -> Escaped a -> f (Escaped b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Escaped a -> f (Escaped b)
$cp2Traversable :: Foldable Escaped
$cp1Traversable :: Functor Escaped
Traversable)

-- | Typeclass for things that may be used as an escaped JChar.
class AsEscaped r digit | r -> digit where
  _Escaped   :: Prism' r (Escaped digit)
  _QuotationMark  :: Prism' r ()
  _ReverseSolidus :: Prism' r ()
  _Solidus        :: Prism' r ()
  _Backspace      :: Prism' r ()
  _WhiteSpace     :: Prism' r Whitespace
  _Hex            :: Prism' r (HexDigit4 digit)

  _QuotationMark  = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p () (f ()) -> p (Escaped digit) (f (Escaped digit)))
-> p () (f ())
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r ()
_QuotationMark
  _ReverseSolidus = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p () (f ()) -> p (Escaped digit) (f (Escaped digit)))
-> p () (f ())
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r ()
_ReverseSolidus
  _Solidus        = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p () (f ()) -> p (Escaped digit) (f (Escaped digit)))
-> p () (f ())
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r ()
_Solidus
  _Backspace      = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p () (f ()) -> p (Escaped digit) (f (Escaped digit)))
-> p () (f ())
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r ()
_Backspace
  _WhiteSpace     = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p Whitespace (f Whitespace)
    -> p (Escaped digit) (f (Escaped digit)))
-> p Whitespace (f Whitespace)
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p Whitespace (f Whitespace)
-> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r Whitespace
_WhiteSpace
  _Hex            = p (Escaped digit) (f (Escaped digit)) -> p r (f r)
forall r digit. AsEscaped r digit => Prism' r (Escaped digit)
_Escaped (p (Escaped digit) (f (Escaped digit)) -> p r (f r))
-> (p (HexDigit4 digit) (f (HexDigit4 digit))
    -> p (Escaped digit) (f (Escaped digit)))
-> p (HexDigit4 digit) (f (HexDigit4 digit))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (HexDigit4 digit) (f (HexDigit4 digit))
-> p (Escaped digit) (f (Escaped digit))
forall r digit. AsEscaped r digit => Prism' r (HexDigit4 digit)
_Hex

instance AsEscaped (Escaped digit) digit where
  _Escaped :: p (Escaped digit) (f (Escaped digit))
-> p (Escaped digit) (f (Escaped digit))
_Escaped = p (Escaped digit) (f (Escaped digit))
-> p (Escaped digit) (f (Escaped digit))
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  _QuotationMark :: p () (f ()) -> p (Escaped digit) (f (Escaped digit))
_QuotationMark = (() -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) ())
-> Prism' (Escaped digit) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Escaped digit -> () -> Escaped digit
forall a b. a -> b -> a
const Escaped digit
forall digit. Escaped digit
QuotationMark)
    (\ Escaped digit
x -> case Escaped digit
x of
        Escaped digit
QuotationMark -> () -> Either (Escaped digit) ()
forall a b. b -> Either a b
Right ()
        Escaped digit
_             -> Escaped digit -> Either (Escaped digit) ()
forall a b. a -> Either a b
Left Escaped digit
x
    )
  _ReverseSolidus :: p () (f ()) -> p (Escaped digit) (f (Escaped digit))
_ReverseSolidus = (() -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) ())
-> Prism' (Escaped digit) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Escaped digit -> () -> Escaped digit
forall a b. a -> b -> a
const Escaped digit
forall digit. Escaped digit
ReverseSolidus)
    (\ Escaped digit
x -> case Escaped digit
x of
        Escaped digit
ReverseSolidus -> () -> Either (Escaped digit) ()
forall a b. b -> Either a b
Right ()
        Escaped digit
_              -> Escaped digit -> Either (Escaped digit) ()
forall a b. a -> Either a b
Left Escaped digit
x
    )
  _Solidus :: p () (f ()) -> p (Escaped digit) (f (Escaped digit))
_Solidus = (() -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) ())
-> Prism' (Escaped digit) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Escaped digit -> () -> Escaped digit
forall a b. a -> b -> a
const Escaped digit
forall digit. Escaped digit
Solidus)
    (\ Escaped digit
x -> case Escaped digit
x of
        Escaped digit
Solidus -> () -> Either (Escaped digit) ()
forall a b. b -> Either a b
Right ()
        Escaped digit
_       -> Escaped digit -> Either (Escaped digit) ()
forall a b. a -> Either a b
Left Escaped digit
x
    )
  _Backspace :: p () (f ()) -> p (Escaped digit) (f (Escaped digit))
_Backspace = (() -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) ())
-> Prism' (Escaped digit) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Escaped digit -> () -> Escaped digit
forall a b. a -> b -> a
const Escaped digit
forall digit. Escaped digit
Backspace)
    (\ Escaped digit
x -> case Escaped digit
x of
        Escaped digit
Backspace -> () -> Either (Escaped digit) ()
forall a b. b -> Either a b
Right ()
        Escaped digit
_         -> Escaped digit -> Either (Escaped digit) ()
forall a b. a -> Either a b
Left Escaped digit
x
    )
  _WhiteSpace :: p Whitespace (f Whitespace)
-> p (Escaped digit) (f (Escaped digit))
_WhiteSpace = (Whitespace -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) Whitespace)
-> Prism' (Escaped digit) Whitespace
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace
    (\ Escaped digit
x -> case Escaped digit
x of
        WhiteSpace Whitespace
y1 -> Whitespace -> Either (Escaped digit) Whitespace
forall a b. b -> Either a b
Right Whitespace
y1
        Escaped digit
_             -> Escaped digit -> Either (Escaped digit) Whitespace
forall a b. a -> Either a b
Left Escaped digit
x
    )
  _Hex :: p (HexDigit4 digit) (f (HexDigit4 digit))
-> p (Escaped digit) (f (Escaped digit))
_Hex = (HexDigit4 digit -> Escaped digit)
-> (Escaped digit -> Either (Escaped digit) (HexDigit4 digit))
-> Prism' (Escaped digit) (HexDigit4 digit)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism HexDigit4 digit -> Escaped digit
forall digit. HexDigit4 digit -> Escaped digit
Hex
    (\ Escaped digit
x -> case Escaped digit
x of
        Hex HexDigit4 digit
y1 -> HexDigit4 digit -> Either (Escaped digit) (HexDigit4 digit)
forall a b. b -> Either a b
Right HexDigit4 digit
y1
        Escaped digit
_      -> Escaped digit -> Either (Escaped digit) (HexDigit4 digit)
forall a b. a -> Either a b
Left Escaped digit
x
    )

-- | Parse an escapted JSON character.
--
-- >>> testparse parseEscaped "\\\""
-- Right QuotationMark
--
-- >>> testparse parseEscaped "\\\\"
-- Right ReverseSolidus
--
-- >>> testparse parseEscaped "\\/"
-- Right Solidus
--
-- >>> testparse parseEscaped "\\b"
-- Right Backspace
--
-- >>> testparse parseEscaped "\\f"
-- Right (WhiteSpace LineFeed)
--
-- >>> testparse parseEscaped "\\n"
-- Right (WhiteSpace NewLine)
--
-- >>> testparse parseEscaped "\\r"
-- Right (WhiteSpace CarriageReturn)
--
-- >>> testparse parseEscaped "\\t"
-- Right (WhiteSpace HorizontalTab)
--
-- >>> testparse parseEscaped "\\u1234" :: Either DecodeError (Escaped HeXDigit)
-- Right (Hex (HexDigit4 HeXDigit1 HeXDigit2 HeXDigit3 HeXDigit4))
--
-- >>> testparsetheneof parseEscaped "\\t"
-- Right (WhiteSpace HorizontalTab)
--
-- >>> testparsethennoteof parseEscaped "\\tx"
-- Right (WhiteSpace HorizontalTab)
parseEscaped ::
  (CharParsing f, HeXaDeCiMaL digit) =>
  f ( Escaped digit )
parseEscaped :: f (Escaped digit)
parseEscaped =
  let
    z :: f (Escaped digit)
z =
      [f (Escaped digit)] -> f (Escaped digit)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((\(Char
c, Escaped digit
p) -> Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
c f Char -> f (Escaped digit) -> f (Escaped digit)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Escaped digit -> f (Escaped digit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Escaped digit
p) ((Char, Escaped digit) -> f (Escaped digit))
-> [(Char, Escaped digit)] -> [f (Escaped digit)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [
          (Char
'"' , Escaped digit
forall digit. Escaped digit
QuotationMark)
        , (Char
'\\', Escaped digit
forall digit. Escaped digit
ReverseSolidus)
        , (Char
'/' , Escaped digit
forall digit. Escaped digit
Solidus)
        , (Char
'b' , Escaped digit
forall digit. Escaped digit
Backspace)
        , (Char
' ' , Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace Whitespace
Space)
        , (Char
'f' , Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace Whitespace
LineFeed)
        , (Char
'n' , Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace Whitespace
NewLine)
        , (Char
'r' , Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace Whitespace
CarriageReturn)
        , (Char
't' , Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace Whitespace
HorizontalTab)
        ])
    h :: f (Escaped digit)
h =
      HexDigit4 digit -> Escaped digit
forall digit. HexDigit4 digit -> Escaped digit
Hex (HexDigit4 digit -> Escaped digit)
-> f (HexDigit4 digit) -> f (Escaped digit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'u' f Char -> f (HexDigit4 digit) -> f (HexDigit4 digit)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f (HexDigit4 digit)
forall (f :: * -> *) digit.
(CharParsing f, HeXaDeCiMaL digit) =>
f (HexDigit4 digit)
parseHexDigit4)
  in
    Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\\' f Char -> f (Escaped digit) -> f (Escaped digit)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (f (Escaped digit)
forall digit. f (Escaped digit)
z f (Escaped digit) -> f (Escaped digit) -> f (Escaped digit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f (Escaped digit)
h)

-- | Convert an 'Escaped' character to a Haskell 'Char'
escapedToChar :: Escaped HeXDigit -> Char
escapedToChar :: Escaped HeXDigit -> Char
escapedToChar = \case
  Escaped HeXDigit
QuotationMark  -> Char
'"'
  Escaped HeXDigit
ReverseSolidus -> Char
'\\'
  Escaped HeXDigit
Solidus        -> Char
'/'
  Escaped HeXDigit
Backspace      -> Char
'\b'
  WhiteSpace Whitespace
wc  -> Whitespace -> Char
escapedWhitespaceChar Whitespace
wc
  Hex HexDigit4 HeXDigit
hd         -> HexDigit4 HeXDigit -> Char
hexDigit4ToChar HexDigit4 HeXDigit
hd

-- | Attempt to convert a Haskell 'Char' to an 'Escaped' JSON character
charToEscaped :: Char -> Maybe (Escaped HeXDigit)
charToEscaped :: Char -> Maybe (Escaped HeXDigit)
charToEscaped Char
c = case Char
c of
  Char
'"'  -> Escaped HeXDigit -> Maybe (Escaped HeXDigit)
forall a. a -> Maybe a
Just Escaped HeXDigit
forall digit. Escaped digit
QuotationMark
  Char
'\\' -> Escaped HeXDigit -> Maybe (Escaped HeXDigit)
forall a. a -> Maybe a
Just Escaped HeXDigit
forall digit. Escaped digit
ReverseSolidus
  Char
'/'  -> Escaped HeXDigit -> Maybe (Escaped HeXDigit)
forall a. a -> Maybe a
Just Escaped HeXDigit
forall digit. Escaped digit
Solidus
  Char
'\b' -> Escaped HeXDigit -> Maybe (Escaped HeXDigit)
forall a. a -> Maybe a
Just Escaped HeXDigit
forall digit. Escaped digit
Backspace
  Char
_    -> Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
-> Char -> Maybe (Escaped HeXDigit)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
forall digit.
(Escaped digit -> Const (First (Escaped HeXDigit)) (Escaped digit))
-> Char -> Const (First (Escaped HeXDigit)) Char
asWhitespace Char
c Maybe (Escaped HeXDigit)
-> Maybe (Escaped HeXDigit) -> Maybe (Escaped HeXDigit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
-> Char -> Maybe (Escaped HeXDigit)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
asHex Char
c
  where
    asWhitespace :: (Escaped digit -> Const (First (Escaped HeXDigit)) (Escaped digit))
-> Char -> Const (First (Escaped HeXDigit)) Char
asWhitespace = (Whitespace -> Const (First (Escaped HeXDigit)) Whitespace)
-> Char -> Const (First (Escaped HeXDigit)) Char
Prism' Char Whitespace
_WhitespaceChar ((Whitespace -> Const (First (Escaped HeXDigit)) Whitespace)
 -> Char -> Const (First (Escaped HeXDigit)) Char)
-> ((Escaped digit
     -> Const (First (Escaped HeXDigit)) (Escaped digit))
    -> Whitespace -> Const (First (Escaped HeXDigit)) Whitespace)
-> (Escaped digit
    -> Const (First (Escaped HeXDigit)) (Escaped digit))
-> Char
-> Const (First (Escaped HeXDigit)) Char
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Whitespace -> Escaped digit)
-> (Escaped digit
    -> Const (First (Escaped HeXDigit)) (Escaped digit))
-> Whitespace
-> Const (First (Escaped HeXDigit)) Whitespace
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Whitespace -> Escaped digit
forall digit. Whitespace -> Escaped digit
WhiteSpace
    asHex :: Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
asHex = (Char -> Maybe (HexDigit4 HeXDigit))
-> Optic'
     (->)
     (Const (First (Escaped HeXDigit)))
     Char
     (Maybe (HexDigit4 HeXDigit))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Char -> Maybe (HexDigit4 HeXDigit)
charToHexDigit4 Optic'
  (->)
  (Const (First (Escaped HeXDigit)))
  Char
  (Maybe (HexDigit4 HeXDigit))
-> ((Escaped HeXDigit
     -> Const (First (Escaped HeXDigit)) (Escaped HeXDigit))
    -> Maybe (HexDigit4 HeXDigit)
    -> Const (First (Escaped HeXDigit)) (Maybe (HexDigit4 HeXDigit)))
-> Getting (First (Escaped HeXDigit)) Char (Escaped HeXDigit)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (HexDigit4 HeXDigit
 -> Const (First (Escaped HeXDigit)) (HexDigit4 HeXDigit))
-> Maybe (HexDigit4 HeXDigit)
-> Const (First (Escaped HeXDigit)) (Maybe (HexDigit4 HeXDigit))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((HexDigit4 HeXDigit
  -> Const (First (Escaped HeXDigit)) (HexDigit4 HeXDigit))
 -> Maybe (HexDigit4 HeXDigit)
 -> Const (First (Escaped HeXDigit)) (Maybe (HexDigit4 HeXDigit)))
-> ((Escaped HeXDigit
     -> Const (First (Escaped HeXDigit)) (Escaped HeXDigit))
    -> HexDigit4 HeXDigit
    -> Const (First (Escaped HeXDigit)) (HexDigit4 HeXDigit))
-> (Escaped HeXDigit
    -> Const (First (Escaped HeXDigit)) (Escaped HeXDigit))
-> Maybe (HexDigit4 HeXDigit)
-> Const (First (Escaped HeXDigit)) (Maybe (HexDigit4 HeXDigit))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (HexDigit4 HeXDigit -> Escaped HeXDigit)
-> (Escaped HeXDigit
    -> Const (First (Escaped HeXDigit)) (Escaped HeXDigit))
-> HexDigit4 HeXDigit
-> Const (First (Escaped HeXDigit)) (HexDigit4 HeXDigit)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to HexDigit4 HeXDigit -> Escaped HeXDigit
forall digit. HexDigit4 digit -> Escaped digit
Hex