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

module Rel8.Internal.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
      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
      either (fail . Text.unpack) pure $ decodeBase16Untyped 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
              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
              b <- digit
              c <- digit
              let
                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
              guard $ result < 0o400
              pure $ toEnum result
              where
                digit :: Parser ByteString Int
digit = do
                  c <- (Char -> Bool) -> Parser ByteString Char
A.satisfy Char -> Bool
isOctDigit
                  pure $ fromEnum c - fromEnum '0'