{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Waargonaut.Types.JString
(
JString
, JString' (..)
, AsJString (..)
, _JStringText
, stringToJString
, parseJString
) where
import Prelude (Eq, Ord, Show, String, foldr)
import Control.Applicative (Applicative, (*>), (<*))
import Control.Category (id, (.))
import Control.Error.Util (note)
import Control.Lens (Prism', Profunctor, Rewrapped,
Wrapped (..), iso, prism, review)
import Data.Either (Either (Right))
import Data.Foldable (Foldable)
import Data.Function (($))
import Data.Functor (Functor, fmap, (<$>))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Traversable (Traversable, traverse)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Digit (HeXDigit)
import Text.Parser.Char (CharParsing, char)
import Text.Parser.Combinators (many)
import Waargonaut.Types.JChar (JChar, charToJChar, jCharToChar,
parseJChar, utf8CharToJChar)
newtype JString' digit =
JString' (Vector (JChar digit))
deriving (JString' digit -> JString' digit -> Bool
(JString' digit -> JString' digit -> Bool)
-> (JString' digit -> JString' digit -> Bool)
-> Eq (JString' digit)
forall digit. Eq digit => JString' digit -> JString' digit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JString' digit -> JString' digit -> Bool
$c/= :: forall digit. Eq digit => JString' digit -> JString' digit -> Bool
== :: JString' digit -> JString' digit -> Bool
$c== :: forall digit. Eq digit => JString' digit -> JString' digit -> Bool
Eq, Eq (JString' digit)
Eq (JString' digit)
-> (JString' digit -> JString' digit -> Ordering)
-> (JString' digit -> JString' digit -> Bool)
-> (JString' digit -> JString' digit -> Bool)
-> (JString' digit -> JString' digit -> Bool)
-> (JString' digit -> JString' digit -> Bool)
-> (JString' digit -> JString' digit -> JString' digit)
-> (JString' digit -> JString' digit -> JString' digit)
-> Ord (JString' digit)
JString' digit -> JString' digit -> Bool
JString' digit -> JString' digit -> Ordering
JString' digit -> JString' digit -> JString' 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 (JString' digit)
forall digit. Ord digit => JString' digit -> JString' digit -> Bool
forall digit.
Ord digit =>
JString' digit -> JString' digit -> Ordering
forall digit.
Ord digit =>
JString' digit -> JString' digit -> JString' digit
min :: JString' digit -> JString' digit -> JString' digit
$cmin :: forall digit.
Ord digit =>
JString' digit -> JString' digit -> JString' digit
max :: JString' digit -> JString' digit -> JString' digit
$cmax :: forall digit.
Ord digit =>
JString' digit -> JString' digit -> JString' digit
>= :: JString' digit -> JString' digit -> Bool
$c>= :: forall digit. Ord digit => JString' digit -> JString' digit -> Bool
> :: JString' digit -> JString' digit -> Bool
$c> :: forall digit. Ord digit => JString' digit -> JString' digit -> Bool
<= :: JString' digit -> JString' digit -> Bool
$c<= :: forall digit. Ord digit => JString' digit -> JString' digit -> Bool
< :: JString' digit -> JString' digit -> Bool
$c< :: forall digit. Ord digit => JString' digit -> JString' digit -> Bool
compare :: JString' digit -> JString' digit -> Ordering
$ccompare :: forall digit.
Ord digit =>
JString' digit -> JString' digit -> Ordering
$cp1Ord :: forall digit. Ord digit => Eq (JString' digit)
Ord, Int -> JString' digit -> ShowS
[JString' digit] -> ShowS
JString' digit -> String
(Int -> JString' digit -> ShowS)
-> (JString' digit -> String)
-> ([JString' digit] -> ShowS)
-> Show (JString' digit)
forall digit. Show digit => Int -> JString' digit -> ShowS
forall digit. Show digit => [JString' digit] -> ShowS
forall digit. Show digit => JString' digit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JString' digit] -> ShowS
$cshowList :: forall digit. Show digit => [JString' digit] -> ShowS
show :: JString' digit -> String
$cshow :: forall digit. Show digit => JString' digit -> String
showsPrec :: Int -> JString' digit -> ShowS
$cshowsPrec :: forall digit. Show digit => Int -> JString' digit -> ShowS
Show, a -> JString' b -> JString' a
(a -> b) -> JString' a -> JString' b
(forall a b. (a -> b) -> JString' a -> JString' b)
-> (forall a b. a -> JString' b -> JString' a) -> Functor JString'
forall a b. a -> JString' b -> JString' a
forall a b. (a -> b) -> JString' a -> JString' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JString' b -> JString' a
$c<$ :: forall a b. a -> JString' b -> JString' a
fmap :: (a -> b) -> JString' a -> JString' b
$cfmap :: forall a b. (a -> b) -> JString' a -> JString' b
Functor, JString' a -> Bool
(a -> m) -> JString' a -> m
(a -> b -> b) -> b -> JString' a -> b
(forall m. Monoid m => JString' m -> m)
-> (forall m a. Monoid m => (a -> m) -> JString' a -> m)
-> (forall m a. Monoid m => (a -> m) -> JString' a -> m)
-> (forall a b. (a -> b -> b) -> b -> JString' a -> b)
-> (forall a b. (a -> b -> b) -> b -> JString' a -> b)
-> (forall b a. (b -> a -> b) -> b -> JString' a -> b)
-> (forall b a. (b -> a -> b) -> b -> JString' a -> b)
-> (forall a. (a -> a -> a) -> JString' a -> a)
-> (forall a. (a -> a -> a) -> JString' a -> a)
-> (forall a. JString' a -> [a])
-> (forall a. JString' a -> Bool)
-> (forall a. JString' a -> Int)
-> (forall a. Eq a => a -> JString' a -> Bool)
-> (forall a. Ord a => JString' a -> a)
-> (forall a. Ord a => JString' a -> a)
-> (forall a. Num a => JString' a -> a)
-> (forall a. Num a => JString' a -> a)
-> Foldable JString'
forall a. Eq a => a -> JString' a -> Bool
forall a. Num a => JString' a -> a
forall a. Ord a => JString' a -> a
forall m. Monoid m => JString' m -> m
forall a. JString' a -> Bool
forall a. JString' a -> Int
forall a. JString' a -> [a]
forall a. (a -> a -> a) -> JString' a -> a
forall m a. Monoid m => (a -> m) -> JString' a -> m
forall b a. (b -> a -> b) -> b -> JString' a -> b
forall a b. (a -> b -> b) -> b -> JString' 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 :: JString' a -> a
$cproduct :: forall a. Num a => JString' a -> a
sum :: JString' a -> a
$csum :: forall a. Num a => JString' a -> a
minimum :: JString' a -> a
$cminimum :: forall a. Ord a => JString' a -> a
maximum :: JString' a -> a
$cmaximum :: forall a. Ord a => JString' a -> a
elem :: a -> JString' a -> Bool
$celem :: forall a. Eq a => a -> JString' a -> Bool
length :: JString' a -> Int
$clength :: forall a. JString' a -> Int
null :: JString' a -> Bool
$cnull :: forall a. JString' a -> Bool
toList :: JString' a -> [a]
$ctoList :: forall a. JString' a -> [a]
foldl1 :: (a -> a -> a) -> JString' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> JString' a -> a
foldr1 :: (a -> a -> a) -> JString' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> JString' a -> a
foldl' :: (b -> a -> b) -> b -> JString' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> JString' a -> b
foldl :: (b -> a -> b) -> b -> JString' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> JString' a -> b
foldr' :: (a -> b -> b) -> b -> JString' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> JString' a -> b
foldr :: (a -> b -> b) -> b -> JString' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> JString' a -> b
foldMap' :: (a -> m) -> JString' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> JString' a -> m
foldMap :: (a -> m) -> JString' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> JString' a -> m
fold :: JString' m -> m
$cfold :: forall m. Monoid m => JString' m -> m
Foldable, Functor JString'
Foldable JString'
Functor JString'
-> Foldable JString'
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JString' a -> f (JString' b))
-> (forall (f :: * -> *) a.
Applicative f =>
JString' (f a) -> f (JString' a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JString' a -> m (JString' b))
-> (forall (m :: * -> *) a.
Monad m =>
JString' (m a) -> m (JString' a))
-> Traversable JString'
(a -> f b) -> JString' a -> f (JString' 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 => JString' (m a) -> m (JString' a)
forall (f :: * -> *) a.
Applicative f =>
JString' (f a) -> f (JString' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JString' a -> m (JString' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JString' a -> f (JString' b)
sequence :: JString' (m a) -> m (JString' a)
$csequence :: forall (m :: * -> *) a. Monad m => JString' (m a) -> m (JString' a)
mapM :: (a -> m b) -> JString' a -> m (JString' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JString' a -> m (JString' b)
sequenceA :: JString' (f a) -> f (JString' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
JString' (f a) -> f (JString' a)
traverse :: (a -> f b) -> JString' a -> f (JString' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JString' a -> f (JString' b)
$cp2Traversable :: Foldable JString'
$cp1Traversable :: Functor JString'
Traversable)
type JString = JString' HeXDigit
instance JString' digit ~ t => Rewrapped (JString' digit) t
instance Wrapped (JString' digit) where
type Unwrapped (JString' digit) = Vector (JChar digit)
_Wrapped' :: p (Unwrapped (JString' digit)) (f (Unwrapped (JString' digit)))
-> p (JString' digit) (f (JString' digit))
_Wrapped' = (JString' digit -> Vector (JChar digit))
-> (Vector (JChar digit) -> JString' digit)
-> Iso
(JString' digit)
(JString' digit)
(Vector (JChar digit))
(Vector (JChar digit))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (JString' Vector (JChar digit)
x) -> Vector (JChar digit)
x) Vector (JChar digit) -> JString' digit
forall digit. Vector (JChar digit) -> JString' digit
JString'
class AsJString a where
_JString :: Prism' a JString
instance AsJString JString where
_JString :: p JString (f JString) -> p JString (f JString)
_JString = p JString (f JString) -> p JString (f JString)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance AsJString [JChar HeXDigit] where
_JString :: p JString (f JString) -> p [JChar HeXDigit] (f [JChar HeXDigit])
_JString = (JString -> [JChar HeXDigit])
-> ([JChar HeXDigit] -> Either [JChar HeXDigit] JString)
-> Prism' [JChar HeXDigit] JString
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(JString' Vector (JChar HeXDigit)
cs) -> Vector (JChar HeXDigit) -> [JChar HeXDigit]
forall a. Vector a -> [a]
V.toList Vector (JChar HeXDigit)
cs) (JString -> Either [JChar HeXDigit] JString
forall a b. b -> Either a b
Right (JString -> Either [JChar HeXDigit] JString)
-> ([JChar HeXDigit] -> JString)
-> [JChar HeXDigit]
-> Either [JChar HeXDigit] JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector (JChar HeXDigit) -> JString
forall digit. Vector (JChar digit) -> JString' digit
JString' (Vector (JChar HeXDigit) -> JString)
-> ([JChar HeXDigit] -> Vector (JChar HeXDigit))
-> [JChar HeXDigit]
-> JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [JChar HeXDigit] -> Vector (JChar HeXDigit)
forall a. [a] -> Vector a
V.fromList)
instance AsJString String where
_JString :: p JString (f JString) -> p String (f String)
_JString = (JString -> String)
-> (String -> Either String JString) -> Prism' String JString
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\(JString' Vector (JChar HeXDigit)
cx) -> Vector Char -> String
forall a. Vector a -> [a]
V.toList (Vector Char -> String) -> Vector Char -> String
forall a b. (a -> b) -> a -> b
$ JChar HeXDigit -> Char
jCharToChar (JChar HeXDigit -> Char) -> Vector (JChar HeXDigit) -> Vector Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (JChar HeXDigit)
cx)
(\String
x -> Vector (JChar HeXDigit) -> JString
forall digit. Vector (JChar digit) -> JString' digit
JString' (Vector (JChar HeXDigit) -> JString)
-> ([JChar HeXDigit] -> Vector (JChar HeXDigit))
-> [JChar HeXDigit]
-> JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [JChar HeXDigit] -> Vector (JChar HeXDigit)
forall a. [a] -> Vector a
V.fromList ([JChar HeXDigit] -> JString)
-> Either String [JChar HeXDigit] -> Either String JString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Either String (JChar HeXDigit))
-> String -> Either String [JChar HeXDigit]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> Maybe (JChar HeXDigit) -> Either String (JChar HeXDigit)
forall a b. a -> Maybe b -> Either a b
note String
x (Maybe (JChar HeXDigit) -> Either String (JChar HeXDigit))
-> (Char -> Maybe (JChar HeXDigit))
-> Char
-> Either String (JChar HeXDigit)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Maybe (JChar HeXDigit)
charToJChar) String
x)
_JStringText :: (Profunctor p, Applicative f) => p Text (f Text) -> p JString (f JString)
_JStringText :: p Text (f Text) -> p JString (f JString)
_JStringText = (JString -> Text)
-> (Text -> JString) -> Iso JString JString Text Text
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (String -> Text
Text.pack (String -> Text) -> (JString -> String) -> JString -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AReview String JString -> JString -> String
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview String JString
forall a. AsJString a => Prism' a JString
_JString) (Vector (JChar HeXDigit) -> JString
forall digit. Vector (JChar digit) -> JString' digit
JString' (Vector (JChar HeXDigit) -> JString)
-> (Text -> Vector (JChar HeXDigit)) -> Text -> JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [JChar HeXDigit] -> Vector (JChar HeXDigit)
forall a. [a] -> Vector a
V.fromList ([JChar HeXDigit] -> Vector (JChar HeXDigit))
-> (Text -> [JChar HeXDigit]) -> Text -> Vector (JChar HeXDigit)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> JChar HeXDigit) -> String -> [JChar HeXDigit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> JChar HeXDigit
utf8CharToJChar (String -> [JChar HeXDigit])
-> (Text -> String) -> Text -> [JChar HeXDigit]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
Text.unpack)
parseJString
:: CharParsing f
=> f JString
parseJString :: f JString
parseJString =
Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"' f Char -> f JString -> f JString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Vector (JChar HeXDigit) -> JString
forall digit. Vector (JChar digit) -> JString' digit
JString' (Vector (JChar HeXDigit) -> JString)
-> ([JChar HeXDigit] -> Vector (JChar HeXDigit))
-> [JChar HeXDigit]
-> JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [JChar HeXDigit] -> Vector (JChar HeXDigit)
forall a. [a] -> Vector a
V.fromList ([JChar HeXDigit] -> JString) -> f [JChar HeXDigit] -> f JString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (JChar HeXDigit) -> f [JChar HeXDigit]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many f (JChar HeXDigit)
forall (f :: * -> *) digit.
(CharParsing f, HeXaDeCiMaL digit) =>
f (JChar digit)
parseJChar) f JString -> f Char -> f JString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"'
stringToJString :: String -> JString
stringToJString :: String -> JString
stringToJString = Vector (JChar HeXDigit) -> JString
forall digit. Vector (JChar digit) -> JString' digit
JString' (Vector (JChar HeXDigit) -> JString)
-> (String -> Vector (JChar HeXDigit)) -> String -> JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Vector (JChar HeXDigit) -> Vector (JChar HeXDigit))
-> Vector (JChar HeXDigit) -> String -> Vector (JChar HeXDigit)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (JChar HeXDigit
-> Vector (JChar HeXDigit) -> Vector (JChar HeXDigit)
forall a. a -> Vector a -> Vector a
V.cons (JChar HeXDigit
-> Vector (JChar HeXDigit) -> Vector (JChar HeXDigit))
-> (Char -> JChar HeXDigit)
-> Char
-> Vector (JChar HeXDigit)
-> Vector (JChar HeXDigit)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> JChar HeXDigit
utf8CharToJChar) Vector (JChar HeXDigit)
forall a. Vector a
V.empty