-- |
--
-- Types and functions for handling valid unescaped characters in JSON.
--
module Waargonaut.Types.JChar.Unescaped
  (
    -- * Types
    Unescaped (..)
  , AsUnescaped (..)

    -- * Parser
  , parseUnescaped
  ) where

import           Prelude          (Eq, Ord (..), Show, (&&), (==), (||))

import           Control.Category (id)
import           Control.Lens     (Prism', has, prism')

import           Data.Foldable    (any)
import           Data.Function    (($))
import           Data.Functor     ((<$>))

import           Data.Char        (Char, ord)
import           Data.Maybe       (Maybe (..))

import           Text.Parser.Char (CharParsing, satisfy)

-- $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
----

-- | Type to specify that this character is unescaped and may be represented
-- using a normal Haskell 'Char'.
newtype Unescaped =
  Unescaped Char
  deriving (Unescaped -> Unescaped -> Bool
(Unescaped -> Unescaped -> Bool)
-> (Unescaped -> Unescaped -> Bool) -> Eq Unescaped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unescaped -> Unescaped -> Bool
$c/= :: Unescaped -> Unescaped -> Bool
== :: Unescaped -> Unescaped -> Bool
$c== :: Unescaped -> Unescaped -> Bool
Eq, Eq Unescaped
Eq Unescaped
-> (Unescaped -> Unescaped -> Ordering)
-> (Unescaped -> Unescaped -> Bool)
-> (Unescaped -> Unescaped -> Bool)
-> (Unescaped -> Unescaped -> Bool)
-> (Unescaped -> Unescaped -> Bool)
-> (Unescaped -> Unescaped -> Unescaped)
-> (Unescaped -> Unescaped -> Unescaped)
-> Ord Unescaped
Unescaped -> Unescaped -> Bool
Unescaped -> Unescaped -> Ordering
Unescaped -> Unescaped -> Unescaped
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
min :: Unescaped -> Unescaped -> Unescaped
$cmin :: Unescaped -> Unescaped -> Unescaped
max :: Unescaped -> Unescaped -> Unescaped
$cmax :: Unescaped -> Unescaped -> Unescaped
>= :: Unescaped -> Unescaped -> Bool
$c>= :: Unescaped -> Unescaped -> Bool
> :: Unescaped -> Unescaped -> Bool
$c> :: Unescaped -> Unescaped -> Bool
<= :: Unescaped -> Unescaped -> Bool
$c<= :: Unescaped -> Unescaped -> Bool
< :: Unescaped -> Unescaped -> Bool
$c< :: Unescaped -> Unescaped -> Bool
compare :: Unescaped -> Unescaped -> Ordering
$ccompare :: Unescaped -> Unescaped -> Ordering
$cp1Ord :: Eq Unescaped
Ord, Int -> Unescaped -> ShowS
[Unescaped] -> ShowS
Unescaped -> String
(Int -> Unescaped -> ShowS)
-> (Unescaped -> String)
-> ([Unescaped] -> ShowS)
-> Show Unescaped
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unescaped] -> ShowS
$cshowList :: [Unescaped] -> ShowS
show :: Unescaped -> String
$cshow :: Unescaped -> String
showsPrec :: Int -> Unescaped -> ShowS
$cshowsPrec :: Int -> Unescaped -> ShowS
Show)

-- | Typeclass for things that may used as an unescaped JChar.
class AsUnescaped a where
  _Unescaped :: Prism' a Unescaped

instance AsUnescaped Unescaped where
  _Unescaped :: p Unescaped (f Unescaped) -> p Unescaped (f Unescaped)
_Unescaped = p Unescaped (f Unescaped) -> p Unescaped (f Unescaped)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance AsUnescaped Char where
  _Unescaped :: p Unescaped (f Unescaped) -> p Char (f Char)
_Unescaped = (Unescaped -> Char)
-> (Char -> Maybe Unescaped) -> Prism' Char Unescaped
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    (\(Unescaped Char
c) -> Char
c)
    (\Char
c ->  if ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char
c) [Char -> Bool]
excluded then Maybe Unescaped
forall a. Maybe a
Nothing
            else Unescaped -> Maybe Unescaped
forall a. a -> Maybe a
Just (Char -> Unescaped
Unescaped Char
c)
    )
    where
      excluded :: [Char -> Bool]
excluded =
        [ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL')
        , (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')
        , (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')
        , \Char
x ->
            let
              c :: Int
c = Char -> Int
ord Char
x
            in
              (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x21) Bool -> Bool -> Bool
||  -- "%x20-21"
              (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x23 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x5B) Bool -> Bool -> Bool
||  -- "%x23-5B"
              (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x5D Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x10FFFF) -- "%x5D-10FFFF"
        ]

-- | Parse an unescaped JSON character.
--
-- >>> testparse parseUnescaped "a"
-- Right (Unescaped 'a')
--
-- >>> testparse parseUnescaped "\8728"
-- Right (Unescaped '\8728')
--
-- >>> testparsetheneof parseUnescaped "a"
-- Right (Unescaped 'a')
--
-- >>> testparsethennoteof parseUnescaped "ax"
-- Right (Unescaped 'a')
parseUnescaped ::
  CharParsing f =>
  f Unescaped
parseUnescaped :: f Unescaped
parseUnescaped =
  Char -> Unescaped
Unescaped (Char -> Unescaped) -> f Char -> f Unescaped
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> f Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (Getting Any Char Unescaped -> Char -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any Char Unescaped
forall a. AsUnescaped a => Prism' a Unescaped
_Unescaped)