-- | Backward-compatibility shim for (de-)serializing 'Nick's
-- using the old 'Read'/'Show' instances which gave freenode
-- special treatment.
module Lambdabot.Compat.FreenodeNick
    ( FreenodeNick(..)
    , freenodeNickMapSerial
    ) where

import Control.Arrow
import qualified Data.Map as M
import Lambdabot.Nick
import Lambdabot.Util.Serial

newtype FreenodeNick = FreenodeNick { FreenodeNick -> Nick
getFreenodeNick :: Nick }
    deriving (FreenodeNick -> FreenodeNick -> Bool
(FreenodeNick -> FreenodeNick -> Bool)
-> (FreenodeNick -> FreenodeNick -> Bool) -> Eq FreenodeNick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreenodeNick -> FreenodeNick -> Bool
$c/= :: FreenodeNick -> FreenodeNick -> Bool
== :: FreenodeNick -> FreenodeNick -> Bool
$c== :: FreenodeNick -> FreenodeNick -> Bool
Eq, Eq FreenodeNick
Eq FreenodeNick
-> (FreenodeNick -> FreenodeNick -> Ordering)
-> (FreenodeNick -> FreenodeNick -> Bool)
-> (FreenodeNick -> FreenodeNick -> Bool)
-> (FreenodeNick -> FreenodeNick -> Bool)
-> (FreenodeNick -> FreenodeNick -> Bool)
-> (FreenodeNick -> FreenodeNick -> FreenodeNick)
-> (FreenodeNick -> FreenodeNick -> FreenodeNick)
-> Ord FreenodeNick
FreenodeNick -> FreenodeNick -> Bool
FreenodeNick -> FreenodeNick -> Ordering
FreenodeNick -> FreenodeNick -> FreenodeNick
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FreenodeNick -> FreenodeNick -> FreenodeNick
$cmin :: FreenodeNick -> FreenodeNick -> FreenodeNick
max :: FreenodeNick -> FreenodeNick -> FreenodeNick
$cmax :: FreenodeNick -> FreenodeNick -> FreenodeNick
>= :: FreenodeNick -> FreenodeNick -> Bool
$c>= :: FreenodeNick -> FreenodeNick -> Bool
> :: FreenodeNick -> FreenodeNick -> Bool
$c> :: FreenodeNick -> FreenodeNick -> Bool
<= :: FreenodeNick -> FreenodeNick -> Bool
$c<= :: FreenodeNick -> FreenodeNick -> Bool
< :: FreenodeNick -> FreenodeNick -> Bool
$c< :: FreenodeNick -> FreenodeNick -> Bool
compare :: FreenodeNick -> FreenodeNick -> Ordering
$ccompare :: FreenodeNick -> FreenodeNick -> Ordering
$cp1Ord :: Eq FreenodeNick
Ord)

instance Show FreenodeNick where
    show :: FreenodeNick -> String
show (FreenodeNick Nick
x)
        | Nick -> String
nTag Nick
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"freenode" = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Nick -> String
nName Nick
x
        | Bool
otherwise            = ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Nick -> String
pckStr Nick
x

instance Read FreenodeNick where
    readsPrec :: Int -> ReadS FreenodeNick
readsPrec Int
prec String
str = ((String, String) -> (FreenodeNick, String))
-> [(String, String)] -> [(FreenodeNick, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> FreenodeNick)
-> (String, String) -> (FreenodeNick, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Nick -> FreenodeNick
FreenodeNick (Nick -> FreenodeNick)
-> (String -> Nick) -> String -> FreenodeNick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Nick
upckStr String
"freenode")) (Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str)

-- Helper functions
upckStr :: String -> String -> Nick
upckStr :: String -> String -> Nick
upckStr String
def String
str
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ac   = String -> String -> Nick
Nick String
def String
str
    | Bool
otherwise = String -> String -> Nick
Nick String
bc (ShowS
forall a. [a] -> [a]
tail String
ac)
    where (String
bc, String
ac) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
str

pckStr :: Nick -> String
pckStr :: Nick -> String
pckStr Nick
nck = Nick -> String
nTag Nick
nck String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Nick -> String
nName Nick
nck

freenodeNickMapSerial :: (Show v, Read v) => Serial (M.Map Nick v)
freenodeNickMapSerial :: Serial (Map Nick v)
freenodeNickMapSerial = (Map Nick v -> Maybe ByteString)
-> (ByteString -> Maybe (Map Nick v)) -> Serial (Map Nick v)
forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial
    (Serial (Map FreenodeNick v)
-> Map FreenodeNick v -> Maybe ByteString
forall s. Serial s -> s -> Maybe ByteString
serialize Serial (Map FreenodeNick v)
forall k v.
(Ord k, Show k, Show v, Read k, Read v) =>
Serial (Map k v)
mapSerial (Map FreenodeNick v -> Maybe ByteString)
-> (Map Nick v -> Map FreenodeNick v)
-> Map Nick v
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nick -> FreenodeNick) -> Map Nick v -> Map FreenodeNick v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic Nick -> FreenodeNick
FreenodeNick)
    ((Map FreenodeNick v -> Map Nick v)
-> Maybe (Map FreenodeNick v) -> Maybe (Map Nick v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FreenodeNick -> Nick) -> Map FreenodeNick v -> Map Nick v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic FreenodeNick -> Nick
getFreenodeNick) (Maybe (Map FreenodeNick v) -> Maybe (Map Nick v))
-> (ByteString -> Maybe (Map FreenodeNick v))
-> ByteString
-> Maybe (Map Nick v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serial (Map FreenodeNick v)
-> ByteString -> Maybe (Map FreenodeNick v)
forall s. Serial s -> ByteString -> Maybe s
deserialize Serial (Map FreenodeNick v)
forall k v.
(Ord k, Show k, Show v, Read k, Read v) =>
Serial (Map k v)
mapSerial)