{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Irc.RawIrcMsg
Description : Low-level representation of IRC messages
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides a parser and printer for the low-level IRC
message format. It handles splitting up IRC commands into the
prefix, command, and arguments.

-}
module Irc.RawIrcMsg
  (
  -- * Low-level IRC messages
    RawIrcMsg(..)
  , TagEntry(..)
  , rawIrcMsg
  , msgTags
  , msgPrefix
  , msgCommand
  , msgParams

  -- * Text format for IRC messages
  , parseRawIrcMsg
  , renderRawIrcMsg
  , prefixParser
  , simpleTokenParser

  -- * Permissive text decoder
  , asUtf8
  ) where

import           Control.Applicative
import           Data.Attoparsec.Text as P
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as Builder
import           Data.List
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Vector (Vector)
import qualified Data.Vector as Vector

import           Irc.UserInfo
import           View

-- | 'RawIrcMsg' breaks down the IRC protocol into its most basic parts.
-- The "trailing" parameter indicated in the IRC protocol with a leading
-- colon will appear as the last parameter in the parameter list.
--
-- Note that RFC 2812 specifies a maximum of 15 parameters.
--
-- This parser is permissive regarding spaces. It aims to parse carefully
-- constructed messages exactly and to make a best effort to recover from
-- extraneous spaces. It makes no effort to validate nicknames, usernames,
-- hostnames, commands, etc. Servers don't all agree on these things.
--
-- @:prefix COMMAND param0 param1 param2 .. paramN@
data RawIrcMsg = RawIrcMsg
  { RawIrcMsg -> [TagEntry]
_msgTags       :: [TagEntry]     -- ^ IRCv3.2 message tags
  , RawIrcMsg -> Maybe UserInfo
_msgPrefix     :: Maybe UserInfo -- ^ Optional sender of message
  , RawIrcMsg -> Text
_msgCommand    :: !Text          -- ^ Command
  , RawIrcMsg -> [Text]
_msgParams     :: [Text]         -- ^ Command parameters
  }
  deriving (RawIrcMsg -> RawIrcMsg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawIrcMsg -> RawIrcMsg -> Bool
$c/= :: RawIrcMsg -> RawIrcMsg -> Bool
== :: RawIrcMsg -> RawIrcMsg -> Bool
$c== :: RawIrcMsg -> RawIrcMsg -> Bool
Eq, ReadPrec [RawIrcMsg]
ReadPrec RawIrcMsg
Int -> ReadS RawIrcMsg
ReadS [RawIrcMsg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawIrcMsg]
$creadListPrec :: ReadPrec [RawIrcMsg]
readPrec :: ReadPrec RawIrcMsg
$creadPrec :: ReadPrec RawIrcMsg
readList :: ReadS [RawIrcMsg]
$creadList :: ReadS [RawIrcMsg]
readsPrec :: Int -> ReadS RawIrcMsg
$creadsPrec :: Int -> ReadS RawIrcMsg
Read, Int -> RawIrcMsg -> ShowS
[RawIrcMsg] -> ShowS
RawIrcMsg -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawIrcMsg] -> ShowS
$cshowList :: [RawIrcMsg] -> ShowS
show :: RawIrcMsg -> [Char]
$cshow :: RawIrcMsg -> [Char]
showsPrec :: Int -> RawIrcMsg -> ShowS
$cshowsPrec :: Int -> RawIrcMsg -> ShowS
Show)

-- | Key value pair representing an IRCv3.2 message tag.
-- The value in this pair has had the message tag unescape
-- algorithm applied.
data TagEntry = TagEntry {-# UNPACK #-} !Text {-# UNPACK #-} !Text
  deriving (TagEntry -> TagEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagEntry -> TagEntry -> Bool
$c/= :: TagEntry -> TagEntry -> Bool
== :: TagEntry -> TagEntry -> Bool
$c== :: TagEntry -> TagEntry -> Bool
Eq, ReadPrec [TagEntry]
ReadPrec TagEntry
Int -> ReadS TagEntry
ReadS [TagEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagEntry]
$creadListPrec :: ReadPrec [TagEntry]
readPrec :: ReadPrec TagEntry
$creadPrec :: ReadPrec TagEntry
readList :: ReadS [TagEntry]
$creadList :: ReadS [TagEntry]
readsPrec :: Int -> ReadS TagEntry
$creadsPrec :: Int -> ReadS TagEntry
Read, Int -> TagEntry -> ShowS
[TagEntry] -> ShowS
TagEntry -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TagEntry] -> ShowS
$cshowList :: [TagEntry] -> ShowS
show :: TagEntry -> [Char]
$cshow :: TagEntry -> [Char]
showsPrec :: Int -> TagEntry -> ShowS
$cshowsPrec :: Int -> TagEntry -> ShowS
Show)

-- | Lens for '_msgTags'
msgTags :: Functor f => ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags :: forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags [TagEntry] -> f [TagEntry]
f RawIrcMsg
m = (\[TagEntry]
x -> RawIrcMsg
m { _msgTags :: [TagEntry]
_msgTags = [TagEntry]
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TagEntry] -> f [TagEntry]
f (RawIrcMsg -> [TagEntry]
_msgTags RawIrcMsg
m)

-- | Lens for '_msgPrefix'
msgPrefix :: Functor f => (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix :: forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix Maybe UserInfo -> f (Maybe UserInfo)
f RawIrcMsg
m = (\Maybe UserInfo
x -> RawIrcMsg
m { _msgPrefix :: Maybe UserInfo
_msgPrefix = Maybe UserInfo
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserInfo -> f (Maybe UserInfo)
f (RawIrcMsg -> Maybe UserInfo
_msgPrefix RawIrcMsg
m)

-- | Lens for '_msgCommand'
msgCommand :: Functor f => (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand :: forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand Text -> f Text
f RawIrcMsg
m = (\Text
x -> RawIrcMsg
m { _msgCommand :: Text
_msgCommand = Text
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (RawIrcMsg -> Text
_msgCommand RawIrcMsg
m)

-- | Lens for '_msgParams'
msgParams :: Functor f => ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams :: forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams [Text] -> f [Text]
f RawIrcMsg
m = (\[Text]
x -> RawIrcMsg
m { _msgParams :: [Text]
_msgParams = [Text]
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> f [Text]
f (RawIrcMsg -> [Text]
_msgParams RawIrcMsg
m)

-- | Attempt to split an IRC protocol message without its trailing newline
-- information into a structured message.
parseRawIrcMsg :: Text -> Maybe RawIrcMsg
parseRawIrcMsg :: Text -> Maybe RawIrcMsg
parseRawIrcMsg Text
x =
  case forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser RawIrcMsg
rawIrcMsgParser Text
x of
    Left{}  -> forall a. Maybe a
Nothing
    Right RawIrcMsg
r -> forall a. a -> Maybe a
Just RawIrcMsg
r

-- | RFC 2812 specifies that there can only be up to
-- 14 "middle" parameters, after that the fifteenth is
-- the final parameter and the trailing : is optional!
maxMiddleParams :: Int
maxMiddleParams :: Int
maxMiddleParams = Int
14

--  Excerpt from https://tools.ietf.org/html/rfc2812#section-2.3.1

--  message    =  [ ":" prefix SPACE ] command [ params ] crlf
--  prefix     =  servername / ( nickname [ [ "!" user ] "@" host ] )
--  command    =  1*letter / 3digit
--  params     =  *14( SPACE middle ) [ SPACE ":" trailing ]
--             =/ 14( SPACE middle ) [ SPACE [ ":" ] trailing ]

--  nospcrlfcl =  %x01-09 / %x0B-0C / %x0E-1F / %x21-39 / %x3B-FF
--                  ; any octet except NUL, CR, LF, " " and ":"
--  middle     =  nospcrlfcl *( ":" / nospcrlfcl )
--  trailing   =  *( ":" / " " / nospcrlfcl )

--  SPACE      =  %x20        ; space character
--  crlf       =  %x0D %x0A   ; "carriage return" "linefeed"

-- | Parse a whole IRC message assuming that the trailing
-- newlines have already been removed. This parser will
-- parse valid messages correctly but will also accept some
-- invalid messages. Presumably the server isn't sending
-- invalid messages!
rawIrcMsgParser :: Parser RawIrcMsg
rawIrcMsgParser :: Parser RawIrcMsg
rawIrcMsgParser =
  do [TagEntry]
tags   <- forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. Char -> Parser b -> Parser (Maybe b)
guarded Char
'@' Parser Text [TagEntry]
tagsParser
     Maybe UserInfo
prefix <- forall b. Char -> Parser b -> Parser (Maybe b)
guarded Char
':' Parser UserInfo
prefixParser
     Text
cmd    <- Parser Text
simpleTokenParser
     [Text]
params <- Int -> Parser [Text]
paramsParser Int
maxMiddleParams
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! RawIrcMsg
       { _msgTags :: [TagEntry]
_msgTags    = [TagEntry]
tags
       , _msgPrefix :: Maybe UserInfo
_msgPrefix  = Maybe UserInfo
prefix
       , _msgCommand :: Text
_msgCommand = Text
cmd
       , _msgParams :: [Text]
_msgParams  = [Text]
params
       }

-- | Parse the list of parameters in a raw message. The RFC
-- allows for up to 15 parameters.
paramsParser ::
  Int {- ^ possible middle parameters -} -> Parser [Text]
paramsParser :: Int -> Parser [Text]
paramsParser !Int
n =
  do Bool
end <- forall t. Chunk t => Parser t Bool
P.atEnd
     if Bool
end
       then forall (m :: * -> *) a. Monad m => a -> m a
return []
       else do Bool
isColon <- Char -> Parser Bool
optionalChar Char
':'
               if Bool
isColon Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
0
                 then Parser [Text]
finalParam
                 else Parser [Text]
middleParam

  where

  finalParam :: Parser [Text]
finalParam =
    do Text
x <- Parser Text
takeText
       let !x' :: Text
x' = Text -> Text
Text.copy Text
x
       forall (m :: * -> *) a. Monad m => a -> m a
return [Text
x']

  middleParam :: Parser [Text]
middleParam =
    do Text
x  <- Parser Text
simpleTokenParser
       [Text]
xs <- Int -> Parser [Text]
paramsParser (Int
nforall a. Num a => a -> a -> a
-Int
1)
       forall (m :: * -> *) a. Monad m => a -> m a
return (Text
xforall a. a -> [a] -> [a]
:[Text]
xs)

tagsParser :: Parser [TagEntry]
tagsParser :: Parser Text [TagEntry]
tagsParser = Parser TagEntry
tagParser forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaces

tagParser :: Parser TagEntry
tagParser :: Parser TagEntry
tagParser =
  do Text
key <- (Char -> Bool) -> Parser Text
P.takeWhile ([Char] -> Char -> Bool
notInClass [Char]
"=; ")
     Maybe Char
_   <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'=')
     Text
val <- (Char -> Bool) -> Parser Text
P.takeWhile ([Char] -> Char -> Bool
notInClass [Char]
"; ")
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> Text -> TagEntry
TagEntry Text
key (Text -> Text
unescapeTagVal Text
val)


unescapeTagVal :: Text -> Text
unescapeTagVal :: Text -> Text
unescapeTagVal = [Char] -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack
  where
    aux :: ShowS
aux (Char
'\\':Char
':':[Char]
xs) = Char
';'forall a. a -> [a] -> [a]
:ShowS
aux [Char]
xs
    aux (Char
'\\':Char
's':[Char]
xs) = Char
' 'forall a. a -> [a] -> [a]
:ShowS
aux [Char]
xs
    aux (Char
'\\':Char
'\\':[Char]
xs) = Char
'\\'forall a. a -> [a] -> [a]
:ShowS
aux [Char]
xs
    aux (Char
'\\':Char
'r':[Char]
xs) = Char
'\r'forall a. a -> [a] -> [a]
:ShowS
aux [Char]
xs
    aux (Char
'\\':Char
'n':[Char]
xs) = Char
'\n'forall a. a -> [a] -> [a]
:ShowS
aux [Char]
xs
    aux (Char
x:[Char]
xs)        = Char
x forall a. a -> [a] -> [a]
: ShowS
aux [Char]
xs
    aux [Char]
""            = [Char]
""

escapeTagVal :: Text -> Text
escapeTagVal :: Text -> Text
escapeTagVal = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
aux
  where
    aux :: Char -> Text
aux Char
';'  = Text
"\\:"
    aux Char
' '  = Text
"\\s"
    aux Char
'\\' = Text
"\\\\"
    aux Char
'\r' = Text
"\\r"
    aux Char
'\n' = Text
"\\n"
    aux Char
x = Char -> Text
Text.singleton Char
x

-- | Parse a rendered 'UserInfo' token.
prefixParser :: Parser UserInfo
prefixParser :: Parser UserInfo
prefixParser =
  do Text
tok <- Parser Text
simpleTokenParser
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> UserInfo
parseUserInfo Text
tok

-- | Take the next space-delimited lexeme
simpleTokenParser :: Parser Text
simpleTokenParser :: Parser Text
simpleTokenParser =
  do Text
xs <- (Char -> Bool) -> Parser Text
P.takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
' ')
     Parser ()
spaces
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> Text
Text.copy Text
xs

spaces :: Parser ()
spaces :: Parser ()
spaces = (Char -> Bool) -> Parser ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
== Char
' ')

-- | Serialize a structured IRC protocol message back into its wire
-- format. This command adds the required trailing newline.
renderRawIrcMsg :: RawIrcMsg -> ByteString
renderRawIrcMsg :: RawIrcMsg -> ByteString
renderRawIrcMsg !RawIrcMsg
m
   = ByteString -> ByteString
L.toStrict
   forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
   forall a b. (a -> b) -> a -> b
$ [TagEntry] -> Builder
renderTags (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags RawIrcMsg
m)
  forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty UserInfo -> Builder
renderPrefix (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
m)
  forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
m)
  forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
buildParams (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
m)
  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
'\r'
  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
'\n'

-- | Construct a new 'RawIrcMsg' without a time or prefix.
rawIrcMsg ::
  Text {- ^ command -} ->
  [Text] {- ^ parameters -} -> RawIrcMsg
rawIrcMsg :: Text -> [Text] -> RawIrcMsg
rawIrcMsg = [TagEntry] -> Maybe UserInfo -> Text -> [Text] -> RawIrcMsg
RawIrcMsg [] forall a. Maybe a
Nothing

renderTags :: [TagEntry] -> Builder
renderTags :: [TagEntry] -> Builder
renderTags [] = forall a. Monoid a => a
mempty
renderTags [TagEntry]
xs
    = Char -> Builder
Builder.char8 Char
'@'
   forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
Builder.char8 Char
';') (forall a b. (a -> b) -> [a] -> [b]
map TagEntry -> Builder
renderTag [TagEntry]
xs))
   forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
' '

renderTag :: TagEntry -> Builder
renderTag :: TagEntry -> Builder
renderTag (TagEntry Text
key Text
val)
  | Text -> Bool
Text.null Text
val = Text -> Builder
Text.encodeUtf8Builder Text
key
  | Bool
otherwise     = Text -> Builder
Text.encodeUtf8Builder Text
key
                 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
'='
                 forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder (Text -> Text
escapeTagVal Text
val)

renderPrefix :: UserInfo -> Builder
renderPrefix :: UserInfo -> Builder
renderPrefix UserInfo
u
   = Char -> Builder
Builder.char8 Char
':'
  forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder (UserInfo -> Text
renderUserInfo UserInfo
u)
  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
' '

-- | Concatenate a list of parameters into a single, space-delimited
-- bytestring. Use a colon for the last parameter if it starts with
-- a colon or contains a space.
buildParams :: [Text] -> Builder
buildParams :: [Text] -> Builder
buildParams [Text
x]
  | Text
" " Text -> Text -> Bool
`Text.isInfixOf` Text
x Bool -> Bool -> Bool
|| Text
":" Text -> Text -> Bool
`Text.isPrefixOf` Text
x Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
x
  = Char -> Builder
Builder.char8 Char
' ' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
':' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder Text
x
buildParams (Text
x:[Text]
xs)
  | Text -> Bool
Text.null Text
x = Char -> Builder
Builder.char8 Char
' ' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder Text
"*" forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
buildParams [Text]
xs
  | Bool
otherwise   = Char -> Builder
Builder.char8 Char
' ' forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.encodeUtf8Builder Text
x   forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
buildParams [Text]
xs
buildParams [] = forall a. Monoid a => a
mempty

-- | When the current input matches the given character parse
-- using the given parser.
guarded :: Char -> Parser b -> Parser (Maybe b)
guarded :: forall b. Char -> Parser b -> Parser (Maybe b)
guarded Char
c Parser b
p =
  do Bool
success <- Char -> Parser Bool
optionalChar Char
c
     if Bool
success then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
p else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing


-- | Returns 'True' iff next character in stream matches argument.
optionalChar :: Char -> Parser Bool
optionalChar :: Char -> Parser Bool
optionalChar Char
c = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Try to decode a message as UTF-8. If that fails interpret it as Windows
-- CP1252 This helps deal with clients like XChat that get clever and otherwise
-- misconfigured clients.
asUtf8 :: ByteString -> Text
asUtf8 :: ByteString -> Text
asUtf8 ByteString
x = case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
x of
             Right Text
txt -> Text
txt
             Left{}    -> ByteString -> Text
decodeCP1252 ByteString
x

-- | Decode a 'ByteString' as CP1252
decodeCP1252 :: ByteString -> Text
decodeCP1252 :: ByteString -> Text
decodeCP1252 ByteString
bs = [Char] -> Text
Text.pack [ Vector Char
cp1252 forall a. Vector a -> Int -> a
Vector.! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x | Word8
x <- ByteString -> [Word8]
B.unpack ByteString
bs ]

-- | This character encoding is a superset of ISO 8859-1 in terms of printable
-- characters, but differs from the IANA's ISO-8859-1 by using displayable
-- characters rather than control characters in the 80 to 9F (hex) range.
cp1252 :: Vector Char
cp1252 :: Vector Char
cp1252 = forall a. [a] -> Vector a
Vector.fromList
       forall a b. (a -> b) -> a -> b
$ [Char
'\x00'..Char
'\x7f']
      forall a. [a] -> [a] -> [a]
++ [Char]
"€\x81‚ƒ„…†‡ˆ‰Š‹Œ\x8dŽ\x8f\x90‘’“”•–—˜™š›œ\x9džŸ"
      forall a. [a] -> [a] -> [a]
++ [Char
'\xa0'..Char
'\xff']