module Network.IRC.CTCP
(
CTCPByteString
, getUnderlyingByteString
, toCTCP
, fromCTCP
, encodeCTCP
, decodeCTCP
, isCTCP
, asCTCP
, orCTCP
) where
import Data.ByteString (ByteString, pack, singleton, unpack)
import Data.List (mapAccumL)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text, splitOn)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Tuple (swap)
import qualified Data.ByteString as B
import qualified Data.Text as T
newtype CTCPByteString = CBS ByteString
deriving (CTCPByteString -> CTCPByteString -> Bool
(CTCPByteString -> CTCPByteString -> Bool)
-> (CTCPByteString -> CTCPByteString -> Bool) -> Eq CTCPByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CTCPByteString -> CTCPByteString -> Bool
$c/= :: CTCPByteString -> CTCPByteString -> Bool
== :: CTCPByteString -> CTCPByteString -> Bool
$c== :: CTCPByteString -> CTCPByteString -> Bool
Eq, Int -> CTCPByteString -> ShowS
[CTCPByteString] -> ShowS
CTCPByteString -> String
(Int -> CTCPByteString -> ShowS)
-> (CTCPByteString -> String)
-> ([CTCPByteString] -> ShowS)
-> Show CTCPByteString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTCPByteString] -> ShowS
$cshowList :: [CTCPByteString] -> ShowS
show :: CTCPByteString -> String
$cshow :: CTCPByteString -> String
showsPrec :: Int -> CTCPByteString -> ShowS
$cshowsPrec :: Int -> CTCPByteString -> ShowS
Show)
getUnderlyingByteString :: CTCPByteString -> ByteString
getUnderlyingByteString :: CTCPByteString -> ByteString
getUnderlyingByteString (CBS ByteString
bs) = ByteString
bs
toCTCP :: Text -> [Text] -> CTCPByteString
toCTCP :: Text -> [Text] -> CTCPByteString
toCTCP Text
cmd [Text]
args = ByteString -> CTCPByteString
encodeCTCP (ByteString -> CTCPByteString)
-> ([Text] -> ByteString) -> [Text] -> CTCPByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> CTCPByteString) -> [Text] -> CTCPByteString
forall a b. (a -> b) -> a -> b
$ Text
cmd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args
encodeCTCP :: ByteString -> CTCPByteString
encodeCTCP :: ByteString -> CTCPByteString
encodeCTCP ByteString
bs = ByteString -> CTCPByteString
CBS (ByteString -> CTCPByteString) -> ByteString -> CTCPByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
singleton Word8
forall i. Integral i => i
soh ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
escape ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
singleton Word8
forall i. Integral i => i
soh
escape :: ByteString -> ByteString
escape :: ByteString -> ByteString
escape = (Word8 -> ByteString) -> ByteString -> ByteString
B.concatMap Word8 -> ByteString
escape'
where
escape' :: Word8 -> ByteString
escape' Word8
x =
case Word8 -> [(Word8, Word8)] -> Maybe Word8
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
x [(Word8, Word8)]
forall i. Integral i => [(i, i)]
encodings of
Just Word8
x' -> [Word8] -> ByteString
pack [Word8
forall i. Integral i => i
esc, Word8
x']
Maybe Word8
Nothing -> Word8 -> ByteString
singleton Word8
x
fromCTCP :: CTCPByteString -> (Text, [Text])
fromCTCP :: CTCPByteString -> (Text, [Text])
fromCTCP CTCPByteString
bs =
case Text -> Text -> [Text]
splitOn (String -> Text
T.pack String
" ") (Text -> [Text])
-> (CTCPByteString -> Text) -> CTCPByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (CTCPByteString -> ByteString) -> CTCPByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTCPByteString -> ByteString
decodeCTCP (CTCPByteString -> [Text]) -> CTCPByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ CTCPByteString
bs of
(Text
cmd : [Text]
args) -> (Text
cmd, [Text]
args)
[Text]
_ -> (String -> Text
T.pack String
"", [])
decodeCTCP :: CTCPByteString -> ByteString
decodeCTCP :: CTCPByteString -> ByteString
decodeCTCP (CBS ByteString
bs) = ByteString -> ByteString
unescape (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.tail (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.init (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
unescape :: ByteString -> ByteString
unescape :: ByteString -> ByteString
unescape = [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Word8] -> [Word8]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Word8] -> [Word8])
-> (ByteString -> [Maybe Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [Maybe Word8]) -> [Maybe Word8]
forall a b. (a, b) -> b
snd ((Bool, [Maybe Word8]) -> [Maybe Word8])
-> (ByteString -> (Bool, [Maybe Word8]))
-> ByteString
-> [Maybe Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Word8 -> (Bool, Maybe Word8))
-> Bool -> [Word8] -> (Bool, [Maybe Word8])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Bool -> Word8 -> (Bool, Maybe Word8)
forall a. Integral a => Bool -> a -> (Bool, Maybe a)
step Bool
False ([Word8] -> (Bool, [Maybe Word8]))
-> (ByteString -> [Word8]) -> ByteString -> (Bool, [Maybe Word8])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
unpack
where
step :: Bool -> a -> (Bool, Maybe a)
step Bool
True a
x = (Bool
False, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> Maybe a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, a)]
forall i. Integral i => [(i, i)]
decodings)
step Bool
False a
0o020 = (Bool
True, Maybe a
forall a. Maybe a
Nothing)
step Bool
_ a
x = (Bool
False, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
soh :: Integral i => i
soh :: i
soh = i
0o001
esc :: Integral i => i
esc :: i
esc = i
0o020
encodings :: Integral i => [(i, i)]
encodings :: [(i, i)]
encodings =
[ (i
0o000, i
0o060)
, (i
0o012, i
0o156)
, (i
0o015, i
0o162)
, (i
0o020, i
0o020)
]
decodings :: Integral i => [(i, i)]
decodings :: [(i, i)]
decodings = ((i, i) -> (i, i)) -> [(i, i)] -> [(i, i)]
forall a b. (a -> b) -> [a] -> [b]
map (i, i) -> (i, i)
forall a b. (a, b) -> (b, a)
swap [(i, i)]
forall i. Integral i => [(i, i)]
encodings
isCTCP :: ByteString -> Bool
isCTCP :: ByteString -> Bool
isCTCP ByteString
bs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (ByteString -> Word8
B.head ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall i. Integral i => i
soh) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (ByteString -> Word8
B.last ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall i. Integral i => i
soh) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: ((Word8, Word8) -> Bool) -> [(Word8, Word8)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Word8 -> ByteString -> Bool) -> ByteString -> Word8 -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> ByteString -> Bool
B.notElem ByteString
bs (Word8 -> Bool)
-> ((Word8, Word8) -> Word8) -> (Word8, Word8) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> Word8
forall a b. (a, b) -> a
fst) [(Word8, Word8)]
forall i. Integral i => [(i, i)]
encodings
asCTCP :: ByteString -> Maybe CTCPByteString
asCTCP :: ByteString -> Maybe CTCPByteString
asCTCP ByteString
bs =
if ByteString -> Bool
isCTCP ByteString
bs
then CTCPByteString -> Maybe CTCPByteString
forall a. a -> Maybe a
Just (CTCPByteString -> Maybe CTCPByteString)
-> CTCPByteString -> Maybe CTCPByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> CTCPByteString
CBS ByteString
bs
else Maybe CTCPByteString
forall a. Maybe a
Nothing
orCTCP :: (ByteString -> a) -> (CTCPByteString -> a) -> ByteString -> a
orCTCP :: (ByteString -> a) -> (CTCPByteString -> a) -> ByteString -> a
orCTCP ByteString -> a
f CTCPByteString -> a
g ByteString
bs = a -> (CTCPByteString -> a) -> Maybe CTCPByteString -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> a
f ByteString
bs) CTCPByteString -> a
g (ByteString -> Maybe CTCPByteString
asCTCP ByteString
bs)