{-# LANGUAGE OverloadedStrings #-}

-- | Unicode CMap defines mapping from glyphs to text

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

-- | Unicode character map
--
-- Font dictionary can contain \"ToUnicode\" key -- reference
-- to a stream with unicode CMap
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)

-- | Parse content of unicode CMap
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

-- | Take the next glyph code from string, also returns the rest of the string
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

-- | Convert glyph to text
--
-- Note: one glyph can represent more then one char, e.g. for ligatures
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

-- | It returns regular ranges and char map
--
-- Array ranges are converted to char map
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
'<'
  -- hex can contain spaces, lets filter them out
  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

-- XXX: wtf?!
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
  ]