{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Messaging.Encoding.String
  ( TextEncoding (..),
    StrEncoding (..),
    Str (..),
    strP_,
    _strP,
    strToJSON,
    strToJEncoding,
    strParseJSON,
    textToJSON,
    textToEncoding,
    textParseJSON,
    base64urlP,
    strEncodeList,
    strListP,
  )
where

import Control.Applicative (optional)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.Types as JT
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (isAlphaNum)
import Data.Int (Int64)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.List.NonEmpty as L
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.System (SystemTime (..))
import Data.Time.Format.ISO8601
import Data.Word (Word16, Word32)
import qualified Data.X509 as X
import qualified Data.X509.Validation as XV
import Simplex.Messaging.Encoding
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Util (bshow, safeDecodeUtf8, (<$?>))

class TextEncoding a where
  textEncode :: a -> Text
  textDecode :: Text -> Maybe a

-- | Serializing human-readable and (where possible) URI-friendly strings for SMP and SMP agent protocols
class StrEncoding a where
  {-# MINIMAL strEncode, (strDecode | strP) #-}
  strEncode :: a -> ByteString

  -- Please note - if you only specify strDecode, it will use base64urlP as default parser before decoding the string
  strDecode :: ByteString -> Either String a
  strDecode = Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseAll Parser a
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strDecode #-}

  strP :: Parser a
  strP = ByteString -> Either String a
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String a)
-> Parser ByteString ByteString -> Parser a
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
base64urlP
  {-# INLINE strP #-}

-- base64url encoding/decoding of ByteStrings - the parser only allows non-empty strings
instance StrEncoding ByteString where
  strEncode :: ByteString -> ByteString
strEncode = ByteString -> ByteString
U.encode
  {-# INLINE strEncode #-}
  strDecode :: ByteString -> Either String ByteString
strDecode = ByteString -> Either String ByteString
U.decode
  {-# INLINE strDecode #-}
  strP :: Parser ByteString ByteString
strP = Parser ByteString ByteString
base64urlP
  {-# INLINE strP #-}

base64urlP :: Parser ByteString
base64urlP :: Parser ByteString ByteString
base64urlP = do
  ByteString
str <- (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
  ByteString
pad <- (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')
  (String -> Parser ByteString ByteString)
-> (ByteString -> Parser ByteString ByteString)
-> Either String ByteString
-> Parser ByteString ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> Parser ByteString ByteString)
-> Either String ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
U.decode (ByteString
str ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pad)

newtype Str = Str {Str -> ByteString
unStr :: ByteString}
  deriving (Str -> Str -> Bool
(Str -> Str -> Bool) -> (Str -> Str -> Bool) -> Eq Str
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
/= :: Str -> Str -> Bool
Eq, Int -> Str -> ShowS
[Str] -> ShowS
Str -> String
(Int -> Str -> ShowS)
-> (Str -> String) -> ([Str] -> ShowS) -> Show Str
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Str -> ShowS
showsPrec :: Int -> Str -> ShowS
$cshow :: Str -> String
show :: Str -> String
$cshowList :: [Str] -> ShowS
showList :: [Str] -> ShowS
Show)

instance StrEncoding Str where
  strEncode :: Str -> ByteString
strEncode = Str -> ByteString
unStr
  strP :: Parser Str
strP = ByteString -> Str
Str (ByteString -> Str) -> Parser ByteString ByteString -> Parser Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser Str -> Parser ByteString (Maybe Char) -> Parser Str
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Char
A.space

-- inherited from ByteString, the parser only allows non-empty strings
-- only Char8 elements may round-trip as B.pack truncates unicode
instance StrEncoding String where
  strEncode :: String -> ByteString
strEncode = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack
  strP :: Parser String
strP = ByteString -> String
B.unpack (ByteString -> String)
-> Parser ByteString ByteString -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

instance StrEncoding Text where
  strEncode :: Text -> ByteString
strEncode = Text -> ByteString
encodeUtf8
  strP :: Parser Text
strP = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text) -> Parser ByteString ByteString -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

instance ToJSON Str where
  toJSON :: Str -> Value
toJSON (Str ByteString
s) = ByteString -> Value
forall a. StrEncoding a => a -> Value
strToJSON ByteString
s
  toEncoding :: Str -> Encoding
toEncoding (Str ByteString
s) = ByteString -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding ByteString
s

instance FromJSON Str where
  parseJSON :: Value -> Parser Str
parseJSON = (ByteString -> Str) -> Parser ByteString -> Parser Str
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Str
Str (Parser ByteString -> Parser Str)
-> (Value -> Parser ByteString) -> Value -> Parser Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser ByteString
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"Str"

instance StrEncoding a => StrEncoding (Maybe a) where
  strEncode :: Maybe a -> ByteString
strEncode = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
  {-# INLINE strEncode #-}
  strP :: Parser (Maybe a)
strP = Parser ByteString a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString a
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance StrEncoding Word16 where
  strEncode :: Word16 -> ByteString
strEncode = String -> ByteString
B.pack (String -> ByteString)
-> (Word16 -> String) -> Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> String
forall a. Show a => a -> String
show
  {-# INLINE strEncode #-}
  strP :: Parser Word16
strP = Parser Word16
forall a. Integral a => Parser a
A.decimal
  {-# INLINE strP #-}

instance StrEncoding Word32 where
  strEncode :: Word32 -> ByteString
strEncode = String -> ByteString
B.pack (String -> ByteString)
-> (Word32 -> String) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show
  {-# INLINE strEncode #-}
  strP :: Parser Word32
strP = Parser Word32
forall a. Integral a => Parser a
A.decimal
  {-# INLINE strP #-}

instance StrEncoding Char where
  strEncode :: Char -> ByteString
strEncode = Char -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode
  {-# INLINE strEncode #-}
  strP :: Parser ByteString Char
strP = Parser ByteString Char
forall a. Encoding a => Parser a
smpP
  {-# INLINE strP #-}

instance StrEncoding Bool where
  strEncode :: Bool -> ByteString
strEncode = Bool -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode
  {-# INLINE strEncode #-}
  strP :: Parser Bool
strP = Parser Bool
forall a. Encoding a => Parser a
smpP
  {-# INLINE strP #-}

instance StrEncoding Int where
  strEncode :: Int -> ByteString
strEncode = Int -> ByteString
forall a. Show a => a -> ByteString
bshow
  {-# INLINE strEncode #-}
  strP :: Parser Int
strP = Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
A.signed Parser Int
forall a. Integral a => Parser a
A.decimal
  {-# INLINE strP #-}

instance StrEncoding Int64 where
  strEncode :: Int64 -> ByteString
strEncode = Int64 -> ByteString
forall a. Show a => a -> ByteString
bshow
  {-# INLINE strEncode #-}
  strP :: Parser Int64
strP = Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
A.signed Parser Int64
forall a. Integral a => Parser a
A.decimal
  {-# INLINE strP #-}

instance StrEncoding SystemTime where
  strEncode :: SystemTime -> ByteString
strEncode = Int64 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (Int64 -> ByteString)
-> (SystemTime -> Int64) -> SystemTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds
  strP :: Parser SystemTime
strP = (Int64 -> Word32 -> SystemTime
`MkSystemTime` Word32
0) (Int64 -> SystemTime) -> Parser Int64 -> Parser SystemTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int64
forall a. StrEncoding a => Parser a
strP

instance StrEncoding UTCTime where
  strEncode :: UTCTime -> ByteString
strEncode = String -> ByteString
B.pack (String -> ByteString)
-> (UTCTime -> String) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show
  strP :: Parser UTCTime
strP = Either String UTCTime
-> (UTCTime -> Either String UTCTime)
-> Maybe UTCTime
-> Either String UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String UTCTime
forall a b. a -> Either a b
Left String
"bad UTCTime") UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (Maybe UTCTime -> Either String UTCTime)
-> (ByteString -> Maybe UTCTime)
-> ByteString
-> Either String UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe UTCTime)
-> (ByteString -> String) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Either String UTCTime)
-> Parser ByteString ByteString -> Parser UTCTime
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';')

instance StrEncoding X.CertificateChain where
  strEncode :: CertificateChain -> ByteString
strEncode = (\(X.CertificateChainRaw [ByteString]
blobs) -> [ByteString] -> ByteString
forall a. StrEncoding a => [a] -> ByteString
strEncodeList [ByteString]
blobs) (CertificateChainRaw -> ByteString)
-> (CertificateChain -> CertificateChainRaw)
-> CertificateChain
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertificateChain -> CertificateChainRaw
X.encodeCertificateChain
  {-# INLINE strEncode #-}
  strP :: Parser CertificateChain
strP = ((Int, String) -> Parser CertificateChain)
-> (CertificateChain -> Parser CertificateChain)
-> Either (Int, String) CertificateChain
-> Parser CertificateChain
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser CertificateChain
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser CertificateChain)
-> ((Int, String) -> String)
-> (Int, String)
-> Parser CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> String
forall a. Show a => a -> String
show) CertificateChain -> Parser CertificateChain
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Int, String) CertificateChain -> Parser CertificateChain)
-> ([ByteString] -> Either (Int, String) CertificateChain)
-> [ByteString]
-> Parser CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertificateChainRaw -> Either (Int, String) CertificateChain
X.decodeCertificateChain (CertificateChainRaw -> Either (Int, String) CertificateChain)
-> ([ByteString] -> CertificateChainRaw)
-> [ByteString]
-> Either (Int, String) CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> CertificateChainRaw
X.CertificateChainRaw ([ByteString] -> Parser CertificateChain)
-> Parser ByteString [ByteString] -> Parser CertificateChain
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString [ByteString]
forall a. StrEncoding a => Parser [a]
strListP
  {-# INLINE strP #-}

instance StrEncoding XV.Fingerprint where
  strEncode :: Fingerprint -> ByteString
strEncode (XV.Fingerprint ByteString
s) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ByteString
s
  {-# INLINE strEncode #-}
  strP :: Parser Fingerprint
strP = ByteString -> Fingerprint
XV.Fingerprint (ByteString -> Fingerprint)
-> Parser ByteString ByteString -> Parser Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

-- lists encode/parse as comma-separated strings
strEncodeList :: StrEncoding a => [a] -> ByteString
strEncodeList :: forall a. StrEncoding a => [a] -> ByteString
strEncodeList = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString)
-> ([a] -> [ByteString]) -> [a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode

strListP :: StrEncoding a => Parser [a]
strListP :: forall a. StrEncoding a => Parser [a]
strListP = Parser a
forall a. StrEncoding a => Parser a
listItem Parser a -> Parser ByteString Char -> Parser ByteString [a]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy'` Char -> Parser ByteString Char
A.char Char
','

-- relies on sepBy1 never returning an empty list
instance StrEncoding a => StrEncoding (L.NonEmpty a) where
  strEncode :: NonEmpty a -> ByteString
strEncode = [a] -> ByteString
forall a. StrEncoding a => [a] -> ByteString
strEncodeList ([a] -> ByteString)
-> (NonEmpty a -> [a]) -> NonEmpty a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
L.toList
  strP :: Parser (NonEmpty a)
strP = [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([a] -> NonEmpty a) -> Parser ByteString [a] -> Parser (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
forall a. StrEncoding a => Parser a
listItem Parser a -> Parser ByteString Char -> Parser ByteString [a]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser ByteString Char
A.char Char
','

instance (StrEncoding a, Ord a) => StrEncoding (Set a) where
  strEncode :: Set a -> ByteString
strEncode = [a] -> ByteString
forall a. StrEncoding a => [a] -> ByteString
strEncodeList ([a] -> ByteString) -> (Set a -> [a]) -> Set a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList
  strP :: Parser (Set a)
strP = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Parser ByteString [a] -> Parser (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
forall a. StrEncoding a => Parser a
listItem Parser a -> Parser ByteString Char -> Parser ByteString [a]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy'` Char -> Parser ByteString Char
A.char Char
','

instance StrEncoding IntSet where
  strEncode :: IntSet -> ByteString
strEncode = [Int] -> ByteString
forall a. StrEncoding a => [a] -> ByteString
strEncodeList ([Int] -> ByteString) -> (IntSet -> [Int]) -> IntSet -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList
  strP :: Parser IntSet
strP = [Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> Parser ByteString [Int] -> Parser IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
forall a. StrEncoding a => Parser a
listItem Parser Int -> Parser ByteString Char -> Parser ByteString [Int]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy'` Char -> Parser ByteString Char
A.char Char
','

listItem :: StrEncoding a => Parser a
listItem :: forall a. StrEncoding a => Parser a
listItem = Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseAll Parser a
forall a. StrEncoding a => Parser a
strP (ByteString -> Either String a)
-> Parser ByteString ByteString -> Parser a
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

instance (StrEncoding a, StrEncoding b) => StrEncoding (a, b) where
  strEncode :: (a, b) -> ByteString
strEncode (a
a, b
b) = [ByteString] -> ByteString
B.unwords [a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode a
a, b -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode b
b]
  {-# INLINE strEncode #-}
  strP :: Parser (a, b)
strP = (,) (a -> b -> (a, b))
-> Parser ByteString a -> Parser ByteString (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (b -> (a, b))
-> Parser ByteString b -> Parser (a, b)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString b
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance (StrEncoding a, StrEncoding b, StrEncoding c) => StrEncoding (a, b, c) where
  strEncode :: (a, b, c) -> ByteString
strEncode (a
a, b
b, c
c) = [ByteString] -> ByteString
B.unwords [a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode a
a, b -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode b
b, c -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode c
c]
  {-# INLINE strEncode #-}
  strP :: Parser (a, b, c)
strP = (,,) (a -> b -> c -> (a, b, c))
-> Parser ByteString a -> Parser ByteString (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (b -> c -> (a, b, c))
-> Parser ByteString b -> Parser ByteString (c -> (a, b, c))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString b
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (c -> (a, b, c))
-> Parser ByteString c -> Parser (a, b, c)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString c
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d) => StrEncoding (a, b, c, d) where
  strEncode :: (a, b, c, d) -> ByteString
strEncode (a
a, b
b, c
c, d
d) = [ByteString] -> ByteString
B.unwords [a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode a
a, b -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode b
b, c -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode c
c, d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode d
d]
  {-# INLINE strEncode #-}
  strP :: Parser (a, b, c, d)
strP = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Parser ByteString a
-> Parser ByteString (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (b -> c -> d -> (a, b, c, d))
-> Parser ByteString b
-> Parser ByteString (c -> d -> (a, b, c, d))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString b
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (c -> d -> (a, b, c, d))
-> Parser ByteString c -> Parser ByteString (d -> (a, b, c, d))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString c
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (d -> (a, b, c, d))
-> Parser ByteString d -> Parser (a, b, c, d)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString d
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d, StrEncoding e) => StrEncoding (a, b, c, d, e) where
  strEncode :: (a, b, c, d, e) -> ByteString
strEncode (a
a, b
b, c
c, d
d, e
e) = [ByteString] -> ByteString
B.unwords [a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode a
a, b -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode b
b, c -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode c
c, d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode d
d, e -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode e
e]
  {-# INLINE strEncode #-}
  strP :: Parser (a, b, c, d, e)
strP = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Parser ByteString a
-> Parser ByteString (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (b -> c -> d -> e -> (a, b, c, d, e))
-> Parser ByteString b
-> Parser ByteString (c -> d -> e -> (a, b, c, d, e))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString b
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (c -> d -> e -> (a, b, c, d, e))
-> Parser ByteString c
-> Parser ByteString (d -> e -> (a, b, c, d, e))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString c
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (d -> e -> (a, b, c, d, e))
-> Parser ByteString d -> Parser ByteString (e -> (a, b, c, d, e))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString d
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (e -> (a, b, c, d, e))
-> Parser ByteString e -> Parser (a, b, c, d, e)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString e
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d, StrEncoding e, StrEncoding f) => StrEncoding (a, b, c, d, e, f) where
  strEncode :: (a, b, c, d, e, f) -> ByteString
strEncode (a
a, b
b, c
c, d
d, e
e, f
f) = [ByteString] -> ByteString
B.unwords [a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode a
a, b -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode b
b, c -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode c
c, d -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode d
d, e -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode e
e, f -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode f
f]
  {-# INLINE strEncode #-}
  strP :: Parser (a, b, c, d, e, f)
strP = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser ByteString a
-> Parser ByteString (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser ByteString b
-> Parser ByteString (c -> d -> e -> f -> (a, b, c, d, e, f))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString b
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser ByteString c
-> Parser ByteString (d -> e -> f -> (a, b, c, d, e, f))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString c
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (d -> e -> f -> (a, b, c, d, e, f))
-> Parser ByteString d
-> Parser ByteString (e -> f -> (a, b, c, d, e, f))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString d
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (e -> f -> (a, b, c, d, e, f))
-> Parser ByteString e
-> Parser ByteString (f -> (a, b, c, d, e, f))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString e
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (f -> (a, b, c, d, e, f))
-> Parser ByteString f -> Parser (a, b, c, d, e, f)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString f
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

strP_ :: StrEncoding a => Parser a
strP_ :: forall a. StrEncoding a => Parser a
strP_ = Parser a
forall a. StrEncoding a => Parser a
strP Parser a -> Parser ByteString Char -> Parser a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space

_strP :: StrEncoding a => Parser a
_strP :: forall a. StrEncoding a => Parser a
_strP = Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString a -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
forall a. StrEncoding a => Parser a
strP

strToJSON :: StrEncoding a => a -> J.Value
strToJSON :: forall a. StrEncoding a => a -> Value
strToJSON = Text -> Value
J.String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
{-# INLINE strToJSON #-}

strToJEncoding :: StrEncoding a => a -> J.Encoding
strToJEncoding :: forall a. StrEncoding a => a -> Encoding
strToJEncoding = Text -> Encoding
forall a. Text -> Encoding' a
JE.text (Text -> Encoding) -> (a -> Text) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
{-# INLINE strToJEncoding #-}

strParseJSON :: StrEncoding a => String -> J.Value -> JT.Parser a
strParseJSON :: forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
name = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
name ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ (String -> Parser a)
-> (a -> Parser a) -> Either String a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> Parser a)
-> (Text -> Either String a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseAll Parser a
forall a. StrEncoding a => Parser a
strP (ByteString -> Either String a)
-> (Text -> ByteString) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

textToJSON :: TextEncoding a => a -> J.Value
textToJSON :: forall a. TextEncoding a => a -> Value
textToJSON = Text -> Value
J.String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. TextEncoding a => a -> Text
textEncode
{-# INLINE textToJSON #-}

textToEncoding :: TextEncoding a => a -> J.Encoding
textToEncoding :: forall a. TextEncoding a => a -> Encoding
textToEncoding = Text -> Encoding
forall a. Text -> Encoding' a
JE.text (Text -> Encoding) -> (a -> Text) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. TextEncoding a => a -> Text
textEncode
{-# INLINE textToEncoding #-}

textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
textParseJSON :: forall a. TextEncoding a => String -> Value -> Parser a
textParseJSON String
name = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
name ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
name) a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Parser a) -> (Text -> Maybe a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
forall a. TextEncoding a => Text -> Maybe a
textDecode