{-# LANGUAGE OverloadedStrings #-}
module Pdf.Content.UnicodeCMap
(
UnicodeCMap(..),
parseUnicodeCMap,
unicodeCMapNextGlyph,
unicodeCMapDecodeGlyph
)
where
import Data.Char
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Base16 as Base16
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly)
import qualified Data.Attoparsec.ByteString.Char8 as P
import Control.Monad
import qualified Control.Monad.Fail as Fail
data UnicodeCMap = UnicodeCMap {
UnicodeCMap -> [(ByteString, ByteString)]
unicodeCMapCodeRanges :: [(ByteString, ByteString)],
UnicodeCMap -> Map Int Text
unicodeCMapChars :: Map Int Text,
UnicodeCMap -> [(Int, Int, Char)]
unicodeCMapRanges :: [(Int, Int, Char)]
}
deriving (Int -> UnicodeCMap -> ShowS
[UnicodeCMap] -> ShowS
UnicodeCMap -> String
(Int -> UnicodeCMap -> ShowS)
-> (UnicodeCMap -> String)
-> ([UnicodeCMap] -> ShowS)
-> Show UnicodeCMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnicodeCMap] -> ShowS
$cshowList :: [UnicodeCMap] -> ShowS
show :: UnicodeCMap -> String
$cshow :: UnicodeCMap -> String
showsPrec :: Int -> UnicodeCMap -> ShowS
$cshowsPrec :: Int -> UnicodeCMap -> ShowS
Show)
parseUnicodeCMap :: ByteString -> Either String UnicodeCMap
parseUnicodeCMap :: ByteString -> Either String UnicodeCMap
parseUnicodeCMap ByteString
cmap =
case (Either String [(ByteString, ByteString)]
codeRanges, Either String (Map Int Text)
chars, Either String ([(Int, Int, Char)], Map Int Text)
ranges) of
(Right [(ByteString, ByteString)]
cr, Right Map Int Text
cs, Right ([(Int, Int, Char)]
rs, Map Int Text
crs)) -> UnicodeCMap -> Either String UnicodeCMap
forall a b. b -> Either a b
Right (UnicodeCMap -> Either String UnicodeCMap)
-> UnicodeCMap -> Either String UnicodeCMap
forall a b. (a -> b) -> a -> b
$ UnicodeCMap :: [(ByteString, ByteString)]
-> Map Int Text -> [(Int, Int, Char)] -> UnicodeCMap
UnicodeCMap {
unicodeCMapCodeRanges :: [(ByteString, ByteString)]
unicodeCMapCodeRanges = [(ByteString, ByteString)]
cr,
unicodeCMapChars :: Map Int Text
unicodeCMapChars = Map Int Text
cs Map Int Text -> Map Int Text -> Map Int Text
forall a. Semigroup a => a -> a -> a
<> Map Int Text
crs,
unicodeCMapRanges :: [(Int, Int, Char)]
unicodeCMapRanges = [(Int, Int, Char)]
rs
}
(Left String
err, Either String (Map Int Text)
_, Either String ([(Int, Int, Char)], Map Int Text)
_) -> String -> Either String UnicodeCMap
forall a b. a -> Either a b
Left (String -> Either String UnicodeCMap)
-> String -> Either String UnicodeCMap
forall a b. (a -> b) -> a -> b
$ String
"CMap code ranges: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
(Either String [(ByteString, ByteString)]
_, Left String
err, Either String ([(Int, Int, Char)], Map Int Text)
_) -> String -> Either String UnicodeCMap
forall a b. a -> Either a b
Left (String -> Either String UnicodeCMap)
-> String -> Either String UnicodeCMap
forall a b. (a -> b) -> a -> b
$ String
"CMap chars: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
(Either String [(ByteString, ByteString)]
_, Either String (Map Int Text)
_, Left String
err) -> String -> Either String UnicodeCMap
forall a b. a -> Either a b
Left (String -> Either String UnicodeCMap)
-> String -> Either String UnicodeCMap
forall a b. (a -> b) -> a -> b
$ String
"CMap ranges: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
where
codeRanges :: Either String [(ByteString, ByteString)]
codeRanges = Parser [(ByteString, ByteString)]
-> ByteString -> Either String [(ByteString, ByteString)]
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser [(ByteString, ByteString)]
codeRangesParser ByteString
cmap
chars :: Either String (Map Int Text)
chars = Parser (Map Int Text) -> ByteString -> Either String (Map Int Text)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser (Map Int Text)
charsParser ByteString
cmap
ranges :: Either String ([(Int, Int, Char)], Map Int Text)
ranges = Parser ([(Int, Int, Char)], Map Int Text)
-> ByteString -> Either String ([(Int, Int, Char)], Map Int Text)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser ([(Int, Int, Char)], Map Int Text)
rangesParser ByteString
cmap
unicodeCMapNextGlyph :: UnicodeCMap -> ByteString -> Maybe (Int, ByteString)
unicodeCMapNextGlyph :: UnicodeCMap -> ByteString -> Maybe (Int, ByteString)
unicodeCMapNextGlyph UnicodeCMap
cmap = Int -> ByteString -> Maybe (Int, ByteString)
go Int
1
where
go :: Int -> ByteString -> Maybe (Int, ByteString)
go Int
5 ByteString
_ = Maybe (Int, ByteString)
forall a. Maybe a
Nothing
go Int
n ByteString
str =
let glyph :: ByteString
glyph = Int -> ByteString -> ByteString
ByteString.take Int
n ByteString
str in
if ByteString -> Int
ByteString.length ByteString
glyph Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n
then Maybe (Int, ByteString)
forall a. Maybe a
Nothing
else if ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> (ByteString, ByteString) -> Bool
inRange ByteString
glyph) (UnicodeCMap -> [(ByteString, ByteString)]
unicodeCMapCodeRanges UnicodeCMap
cmap)
then (Int, ByteString) -> Maybe (Int, ByteString)
forall a. a -> Maybe a
Just (ByteString -> Int
toCode ByteString
glyph, Int -> ByteString -> ByteString
ByteString.drop Int
n ByteString
str)
else Int -> ByteString -> Maybe (Int, ByteString)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
str
inRange :: ByteString -> (ByteString, ByteString) -> Bool
inRange ByteString
glyph (ByteString
start, ByteString
end)
= ByteString -> Int
ByteString.length ByteString
glyph Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
ByteString.length ByteString
start
Bool -> Bool -> Bool
&& ByteString
glyph ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString
start Bool -> Bool -> Bool
&& ByteString
glyph ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString
end
toCode :: ByteString -> Int
toCode :: ByteString -> Int
toCode ByteString
bs = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> ByteString -> (Int, Int)
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr (\Word8
b (Int
sm, Int
i) ->
(Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256)) (Int
0, Int
1) ByteString
bs
unicodeCMapDecodeGlyph :: UnicodeCMap -> Int -> Maybe Text
unicodeCMapDecodeGlyph :: UnicodeCMap -> Int -> Maybe Text
unicodeCMapDecodeGlyph UnicodeCMap
cmap Int
glyph =
case Int -> Map Int Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
glyph (UnicodeCMap -> Map Int Text
unicodeCMapChars UnicodeCMap
cmap) of
Just Text
txt -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
Maybe Text
Nothing ->
case ((Int, Int, Char) -> Bool)
-> [(Int, Int, Char)] -> [(Int, Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Int, Char) -> Bool
forall c. (Int, Int, c) -> Bool
inRange (UnicodeCMap -> [(Int, Int, Char)]
unicodeCMapRanges UnicodeCMap
cmap) of
[(Int
start, Int
_, Char
char)] -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum
(Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
char) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
glyph Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start))
[(Int, Int, Char)]
_ -> Maybe Text
forall a. Maybe a
Nothing
where
inRange :: (Int, Int, c) -> Bool
inRange (Int
start, Int
end, c
_) = Int
glyph Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
start Bool -> Bool -> Bool
&& Int
glyph Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
end
charsParser :: Parser (Map Int Text)
charsParser :: Parser (Map Int Text)
charsParser =
[Map Int Text] -> Map Int Text
forall a. [Map Int a] -> Map Int a
combineChars ([Map Int Text] -> Map Int Text)
-> Parser ByteString [Map Int Text] -> Parser (Map Int Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map Int Text) -> Parser ByteString [Map Int Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser (Map Int Text)
charsParser'
where
combineChars :: [Map Int a] -> Map Int a
combineChars = (Map Int a -> Map Int a -> Map Int a)
-> Map Int a -> [Map Int a] -> Map Int a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map Int a -> Map Int a -> Map Int a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Int a
forall k a. Map k a
Map.empty
charsParser' :: Parser (Map Int Text)
charsParser' :: Parser (Map Int Text)
charsParser' = do
Int
n <- Parser Int -> Parser Int
forall a. Parser a -> Parser a
skipTillParser (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ do
Int
n <- Parser Int
forall a. Integral a => Parser a
P.decimal
Parser ()
P.skipSpace
ByteString
_ <- ByteString -> Parser ByteString
P.string ByteString
"beginbfchar"
Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
[(Int, Text)]
chars <- Int
-> Parser ByteString (Int, Text) -> Parser ByteString [(Int, Text)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Parser ByteString (Int, Text) -> Parser ByteString [(Int, Text)])
-> Parser ByteString (Int, Text) -> Parser ByteString [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ do
Parser ()
P.skipSpace
ByteString
i <- Parser ByteString
parseHex
Parser ()
P.skipSpace
ByteString
j <- Parser ByteString
parseHex
(Int, Text) -> Parser ByteString (Int, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int
toCode ByteString
i, ByteString -> Text
Text.decodeUtf16BE ByteString
j)
Map Int Text -> Parser (Map Int Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Int Text -> Parser (Map Int Text))
-> Map Int Text -> Parser (Map Int Text)
forall a b. (a -> b) -> a -> b
$ [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, Text)]
chars
rangesParser :: Parser ([(Int, Int, Char)], Map Int Text)
rangesParser :: Parser ([(Int, Int, Char)], Map Int Text)
rangesParser =
[([(Int, Int, Char)], Map Int Text)]
-> ([(Int, Int, Char)], Map Int Text)
forall a a. [([a], Map Int a)] -> ([a], Map Int a)
combineRanges ([([(Int, Int, Char)], Map Int Text)]
-> ([(Int, Int, Char)], Map Int Text))
-> Parser ByteString [([(Int, Int, Char)], Map Int Text)]
-> Parser ([(Int, Int, Char)], Map Int Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ([(Int, Int, Char)], Map Int Text)
-> Parser ByteString [([(Int, Int, Char)], Map Int Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser ([(Int, Int, Char)], Map Int Text)
rangesParser'
where
combineRanges :: [([a], Map Int a)] -> ([a], Map Int a)
combineRanges = (([a], Map Int a) -> ([a], Map Int a) -> ([a], Map Int a))
-> ([a], Map Int a) -> [([a], Map Int a)] -> ([a], Map Int a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ([a], Map Int a) -> ([a], Map Int a) -> ([a], Map Int a)
forall k a a.
Ord k =>
([a], Map k a) -> ([a], Map k a) -> ([a], Map k a)
combineRange ([], Map Int a
forall k a. Map k a
Map.empty)
combineRange :: ([a], Map k a) -> ([a], Map k a) -> ([a], Map k a)
combineRange ([a]
ranges, Map k a
rmap) ([a]
ranges', Map k a
rmap') =
([a]
ranges [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ranges', Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
rmap Map k a
rmap')
rangesParser' :: Parser ([(Int, Int, Char)], Map Int Text)
rangesParser' :: Parser ([(Int, Int, Char)], Map Int Text)
rangesParser' = do
Int
n <- Parser Int -> Parser Int
forall a. Parser a -> Parser a
skipTillParser (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ do
Int
n <- Parser Int
forall a. Integral a => Parser a
P.decimal
Parser ()
P.skipSpace
Parser ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ()) -> Parser ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
P.string ByteString
"beginbfrange"
Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n :: Int)
let go :: a
-> [(Int, Int, Char)]
-> Map Int Text
-> Parser ([(Int, Int, Char)], Map Int Text)
go a
0 [(Int, Int, Char)]
rs Map Int Text
cs = ([(Int, Int, Char)], Map Int Text)
-> Parser ([(Int, Int, Char)], Map Int Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int, Char)]
rs, Map Int Text
cs)
go a
count [(Int, Int, Char)]
rs Map Int Text
cs = do
Parser ()
P.skipSpace
Int
i <- ByteString -> Int
toCode (ByteString -> Int) -> Parser ByteString -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
parseHex
Parser ()
P.skipSpace
Int
j <- ByteString -> Int
toCode (ByteString -> Int) -> Parser ByteString -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
parseHex
Parser ()
P.skipSpace
Either ByteString [ByteString]
k <- Parser ByteString
-> Parser ByteString [ByteString]
-> Parser ByteString (Either ByteString [ByteString])
forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
P.eitherP Parser ByteString
parseHex Parser ByteString [ByteString]
parseHexArray
case Either ByteString [ByteString]
k of
Left ByteString
h -> do
Char
c <- case Text -> Maybe (Char, Text)
Text.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf16BE ByteString
h of
Maybe (Char, Text)
Nothing -> String -> Parser ByteString Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't decode range"
Just (Char
v, Text
_) -> Char -> Parser ByteString Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
v
a
-> [(Int, Int, Char)]
-> Map Int Text
-> Parser ([(Int, Int, Char)], Map Int Text)
go (a -> a
forall a. Enum a => a -> a
pred a
count) ((Int
i, Int
j, Char
c) (Int, Int, Char) -> [(Int, Int, Char)] -> [(Int, Int, Char)]
forall a. a -> [a] -> [a]
: [(Int, Int, Char)]
rs) Map Int Text
cs
Right [ByteString]
hs -> do
let cs' :: [(Int, Text)]
cs' = [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
i..Int
j] ([Text] -> [(Int, Text)])
-> ([ByteString] -> [Text]) -> [ByteString] -> [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
Text.decodeUtf16BE ([ByteString] -> [(Int, Text)]) -> [ByteString] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ [ByteString]
hs
a
-> [(Int, Int, Char)]
-> Map Int Text
-> Parser ([(Int, Int, Char)], Map Int Text)
go (a -> a
forall a. Enum a => a -> a
pred a
count) [(Int, Int, Char)]
rs (Map Int Text
cs Map Int Text -> Map Int Text -> Map Int Text
forall a. Semigroup a => a -> a -> a
<> [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, Text)]
cs')
Int
-> [(Int, Int, Char)]
-> Map Int Text
-> Parser ([(Int, Int, Char)], Map Int Text)
forall a.
(Eq a, Num a, Enum a) =>
a
-> [(Int, Int, Char)]
-> Map Int Text
-> Parser ([(Int, Int, Char)], Map Int Text)
go Int
n [(Int, Int, Char)]
forall a. Monoid a => a
mempty Map Int Text
forall a. Monoid a => a
mempty
codeRangesParser :: Parser [(ByteString, ByteString)]
codeRangesParser :: Parser [(ByteString, ByteString)]
codeRangesParser = do
Int
n <- Parser Int -> Parser Int
forall a. Parser a -> Parser a
skipTillParser (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ do
Int
n <- Parser Int
forall a. Integral a => Parser a
P.decimal
Parser ()
P.skipSpace
Parser ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ()) -> Parser ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
P.string ByteString
"begincodespacerange"
Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
Int
-> Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)])
-> Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ do
Parser ()
P.skipSpace
ByteString
i <- Parser ByteString
parseHex
Parser ()
P.skipSpace
ByteString
j <- Parser ByteString
parseHex
(ByteString, ByteString)
-> Parser ByteString (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
i, ByteString
j)
parseHex :: Parser ByteString
parseHex :: Parser ByteString
parseHex = do
Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
P.char Char
'<'
ByteString
res <- (Char -> Bool) -> Parser ByteString
P.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>') Parser ByteString
-> (ByteString -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser ByteString
forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
fromHex (ByteString -> Parser ByteString)
-> (ByteString -> ByteString) -> ByteString -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
ByteString.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
32)
Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
P.char Char
'>'
ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
parseHexArray :: Parser [ByteString]
parseHexArray :: Parser ByteString [ByteString]
parseHexArray = do
Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
P.char Char
'['
[ByteString]
res <- Parser ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser ByteString -> Parser ByteString [ByteString])
-> Parser ByteString -> Parser ByteString [ByteString]
forall a b. (a -> b) -> a -> b
$ do
Parser ()
P.skipSpace
Parser ByteString
parseHex
Parser ()
P.skipSpace
Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
P.char Char
']'
[ByteString] -> Parser ByteString [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
res
fromHex :: Fail.MonadFail m => ByteString -> m ByteString
fromHex :: ByteString -> m ByteString
fromHex ByteString
hex = do
case ByteString -> Either String ByteString
Base16.decode (ByteString -> ByteString
bsToLower ByteString
hex) of
Left String
err -> String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right ByteString
str -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
str
where
bsToLower :: ByteString -> ByteString
bsToLower = (Word8 -> Word8) -> ByteString -> ByteString
ByteString.map ((Word8 -> Word8) -> ByteString -> ByteString)
-> (Word8 -> Word8) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
(Char -> Int) -> (Word8 -> Char) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower
(Char -> Char) -> (Word8 -> Char) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum
(Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
skipTillParser :: Parser a -> Parser a
skipTillParser :: Parser a -> Parser a
skipTillParser Parser a
p = [Parser a] -> Parser a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice [
Parser a
p,
Parser ByteString Char
P.anyChar Parser ByteString Char -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> Parser a
forall a. Parser a -> Parser a
skipTillParser Parser a
p
]