{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.MIME.QuotedPrintable
(
contentTransferEncodingQuotedPrintable
, q
, QuotedPrintableMode(..)
, encodingRequiredEOL
, encodingRequiredNonEOL
) where
import Control.Lens (APrism', prism')
import Data.Bool (bool)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Data.Word (Word8)
import Foreign
( Ptr, withForeignPtr, nullPtr, plusPtr, minusPtr
, peek, peekByteOff, poke
)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Data.MIME.Internal
import Data.MIME.Types
data QuotedPrintableMode = QuotedPrintable | Q
deriving (QuotedPrintableMode -> QuotedPrintableMode -> Bool
(QuotedPrintableMode -> QuotedPrintableMode -> Bool)
-> (QuotedPrintableMode -> QuotedPrintableMode -> Bool)
-> Eq QuotedPrintableMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
$c/= :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
== :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
$c== :: QuotedPrintableMode -> QuotedPrintableMode -> Bool
Eq)
encodingRequiredNonEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL QuotedPrintableMode
mode Word8
c =
(Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
9 )
Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
61
Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
127
Bool -> Bool -> Bool
|| QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
95 Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9 Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
63 )
encodingRequiredEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL :: QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL QuotedPrintableMode
mode Word8
c = Bool -> Bool
not (
(Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
60)
Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
62 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126)
) Bool -> Bool -> Bool
|| (QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
95 )
encodeQuotedPrintable :: QuotedPrintableMode -> B.ByteString -> B.ByteString
encodeQuotedPrintable :: QuotedPrintableMode -> ByteString -> ByteString
encodeQuotedPrintable QuotedPrintableMode
mode ByteString
s = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
Int
l <- QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> Int)
-> Ptr Word8
-> ByteString
-> IO Int
forall r.
QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode
(\Ptr Word8
_ Word8
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Int -> Int
forall a. a -> a
id Ptr Word8
forall a. Ptr a
nullPtr ByteString
s
ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
l
ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> ByteString)
-> Ptr Word8
-> ByteString
-> IO ByteString
forall r.
QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0) Ptr Word8
dptr ByteString
s
encodeQuotedPrintable'
:: QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> B.ByteString
-> IO r
encodeQuotedPrintable' :: QuotedPrintableMode
-> (Ptr Word8 -> Word8 -> IO ())
-> (Int -> r)
-> Ptr Word8
-> ByteString
-> IO r
encodeQuotedPrintable' QuotedPrintableMode
mode Ptr Word8 -> Word8 -> IO ()
poke' Int -> r
mkResult Ptr Word8
dptr (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) =
(Int -> r) -> IO Int -> IO r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> r
mkResult (IO Int -> IO r) -> IO Int -> IO r
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr b
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
crlf :: Ptr Word8 -> IO Bool
crlf :: Ptr Word8 -> IO Bool
crlf Ptr Word8
ptr
| QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Bool
otherwise = do
Word8
c1 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
ptr Int
1
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Word8
c1 :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 Bool -> Bool -> Bool
&& (Word8
c2 :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10
pokeHardLineBreak :: Ptr Word8 -> IO ()
pokeHardLineBreak Ptr Word8
ptr =
Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
13 IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
10
pokeSoftLineBreak :: Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
ptr =
Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
61 IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> IO ()
pokeHardLineBreak (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
pokeEncoded :: Ptr Word8 -> Word8 -> IO ()
pokeEncoded Ptr Word8
ptr Word8
c =
let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
hexEncode Word8
c
in Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
ptr Word8
61
IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hi
IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
lo
mapChar :: p -> p
mapChar p
32 | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q = p
95
mapChar p
c = p
c
wrapLimit :: Int
wrapLimit = if QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q then Int
forall a. Bounded a => a
maxBound else Int
76
fill :: Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
col !Ptr Word8
dp !Ptr Word8
sp
| Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall a. Ptr a
slimit = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr
| Bool
otherwise = do
Bool
atEOL <- Ptr Word8 -> IO Bool
crlf Ptr Word8
sp
if Bool
atEOL
then Ptr Word8 -> IO ()
pokeHardLineBreak Ptr Word8
dp
IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
0 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
else do
Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
Bool
cAtEOL <- Ptr Word8 -> IO Bool
crlf (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
let
encodingRequired :: Bool
encodingRequired =
(Bool
cAtEOL Bool -> Bool -> Bool
&& QuotedPrintableMode -> Word8 -> Bool
encodingRequiredEOL QuotedPrintableMode
mode Word8
c)
Bool -> Bool -> Bool
|| QuotedPrintableMode -> Word8 -> Bool
encodingRequiredNonEOL QuotedPrintableMode
mode Word8
c
bytesNeeded :: Int
bytesNeeded = Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
1 Int
3 Bool
encodingRequired
c' :: Word8
c' = Word8 -> Word8
forall p. (Eq p, Num p) => p -> p
mapChar Word8
c
case (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
wrapLimit, Bool
encodingRequired) of
(Bool
False, Bool
False) ->
Ptr Word8 -> Word8 -> IO ()
poke' Ptr Word8
dp Word8
c'
IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded) (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytesNeeded) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
(Bool
False, Bool
True) ->
Ptr Word8 -> Word8 -> IO ()
pokeEncoded Ptr Word8
dp Word8
c'
IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytesNeeded) (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytesNeeded) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
(Bool
True, Bool
False) ->
Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
dp
IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
poke' (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
c'
IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
1 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
(Bool
True, Bool
True) ->
Ptr Word8 -> IO ()
pokeSoftLineBreak Ptr Word8
dp
IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Word8 -> IO ()
pokeEncoded (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
c'
IO () -> IO Int -> IO Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
3 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
6) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Int -> Ptr Word8 -> Ptr Word8 -> IO Int
fill Int
0 Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
decodeQuotedPrintable :: QuotedPrintableMode -> B.ByteString -> Either String B.ByteString
decodeQuotedPrintable :: QuotedPrintableMode -> ByteString -> Either String ByteString
decodeQuotedPrintable QuotedPrintableMode
mode (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = IO (Either String ByteString) -> Either String ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String ByteString) -> Either String ByteString)
-> IO (Either String ByteString) -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
slen
Either String Int
result <- ForeignPtr Word8
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int))
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
ForeignPtr Word8
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int))
-> (Ptr Word8 -> IO (Either String Int)) -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr b
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
fill :: Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill !Ptr Word8
dp !Ptr Word8
sp
| Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall a. Ptr a
slimit = Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either a Int
forall a b. b -> Either a b
Right (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
| Bool
otherwise = do
Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
case (Word8
c :: Word8) of
Word8
61 ->
if Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit
then Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"reached end of input during '=' decoding"
else do
Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
1
case Word8
c1 of
Word8
10 -> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dp (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
Word8
_ ->
if Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall a. Ptr a
slimit
then Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"reached end of input during '=' decoding"
else do
Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
2
case (Word8
c1, Word8
c2) of
(Word8
13, Word8
10) ->
Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dp (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
(Word8, Word8)
_ ->
IO (Either a Int)
-> ((Word8, Word8) -> IO (Either a Int))
-> Maybe (Word8, Word8)
-> IO (Either a Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"invalid hex sequence")
(\(Word8
hi,Word8
lo) -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp (Word8
hi Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
lo)
Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) )
((,) (Word8 -> Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8 -> (Word8, Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
parseHex Word8
c1 Maybe (Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8, Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Maybe Word8
parseHex Word8
c2)
Word8
95 | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q ->
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
32 IO () -> IO (Either a Int) -> IO (Either a Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Word8
32 | QuotedPrintableMode
mode QuotedPrintableMode -> QuotedPrintableMode -> Bool
forall a. Eq a => a -> a -> Bool
== QuotedPrintableMode
Q ->
Either a Int -> IO (Either a Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a Int -> IO (Either a Int))
-> Either a Int -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ a -> Either a Int
forall a b. a -> Either a b
Left a
"space cannot appear in 'Q' encoding"
Word8
_ ->
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
c IO () -> IO (Either a Int) -> IO (Either a Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> Ptr Word8 -> IO (Either String Int)
forall a. IsString a => Ptr Word8 -> Ptr Word8 -> IO (Either a Int)
fill Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
Either String ByteString -> IO (Either String ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> IO (Either String ByteString))
-> Either String ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 (Int -> ByteString)
-> Either String Int -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Int
result
mkPrism :: QuotedPrintableMode -> APrism' B.ByteString B.ByteString
mkPrism :: QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
mode = (ByteString -> ByteString)
-> (ByteString -> Maybe ByteString)
-> Prism ByteString ByteString ByteString ByteString
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
(QuotedPrintableMode -> ByteString -> ByteString
encodeQuotedPrintable QuotedPrintableMode
mode)
((String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuotedPrintableMode -> ByteString -> Either String ByteString
decodeQuotedPrintable QuotedPrintableMode
mode)
contentTransferEncodingQuotedPrintable :: ContentTransferEncoding
contentTransferEncodingQuotedPrintable :: APrism' ByteString ByteString
contentTransferEncodingQuotedPrintable = QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
QuotedPrintable
q :: EncodedWordEncoding
q :: APrism' ByteString ByteString
q = QuotedPrintableMode -> APrism' ByteString ByteString
mkPrism QuotedPrintableMode
Q