{-# language OverloadedStrings #-}
{-# language TypeApplications #-}

module Rel8.Type.Parser.ByteString
  ( bytestring
  )
where

-- attoparsec
import qualified Data.Attoparsec.ByteString.Char8 as A

-- base
import Control.Applicative ((<|>), many)
import Control.Monad (guard)
import Data.Bits ((.|.), shiftL)
import Data.Char (isOctDigit)
import Data.Foldable (fold)
import Prelude

-- base16
import Data.ByteString.Base16 (decodeBase16Untyped)

-- bytestring
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS

-- text
import qualified Data.Text as Text


bytestring :: A.Parser ByteString
bytestring :: Parser ByteString
bytestring = Parser ByteString
hex Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
escape
  where
    hex :: Parser ByteString
hex = do
      ByteString
digits <- Parser ByteString
"\\x" Parser ByteString -> Parser ByteString -> Parser ByteString
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.takeByteString
      (Text -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either Text ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString)
-> (Text -> String) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ByteString -> Parser ByteString)
-> Either Text ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
decodeBase16Untyped ByteString
digits
    escape :: Parser ByteString
escape = [ByteString] -> ByteString
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser ByteString [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString
escaped Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
unescaped)
      where
        unescaped :: Parser ByteString
unescaped = (Char -> Bool) -> Parser ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')
        escaped :: Parser ByteString
escaped = Char -> ByteString
BS.singleton (Char -> ByteString) -> Parser ByteString Char -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char
backslash Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Char
octal)
          where
            backslash :: Parser ByteString Char
backslash = Char
'\\' Char -> Parser ByteString -> Parser ByteString Char
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString
"\\\\"
            octal :: Parser ByteString Char
octal = do
              Int
a <- Char -> Parser ByteString Char
A.char Char
'\\' Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
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 Int
digit
              Int
b <- Parser ByteString Int
digit
              Int
c <- Parser ByteString Int
digit
              let
                result :: Int
result = Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c
              Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ByteString ()) -> Bool -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int
result Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0o400
              Char -> Parser ByteString Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Parser ByteString Char) -> Char -> Parser ByteString Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum Int
result
              where
                digit :: Parser ByteString Int
digit = do
                  Char
c <- (Char -> Bool) -> Parser ByteString Char
A.satisfy Char -> Bool
isOctDigit
                  Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser ByteString Int) -> Int -> Parser ByteString Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'