{-# LANGUAGE FlexibleInstances #-}
module Lambdabot.Util.Serial
( Serial(..)
, stdSerial
, mapSerial
, mapPackedSerial
, assocListPackedSerial
, mapListPackedSerial
, readM
, Packable(..)
, readOnly
) where
import Control.Monad.Fail (MonadFail)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as P
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Lazy (fromChunks,toChunks)
import Codec.Compression.GZip
data Serial s = Serial {
forall s. Serial s -> s -> Maybe ByteString
serialize :: s -> Maybe ByteString,
forall s. Serial s -> ByteString -> Maybe s
deserialize :: ByteString -> Maybe s
}
gzip :: ByteString -> ByteString
gzip :: ByteString -> ByteString
gzip = [ByteString] -> ByteString
P.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
gunzip :: ByteString -> ByteString
gunzip :: ByteString -> ByteString
gunzip = [ByteString] -> ByteString
P.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
readOnly :: (ByteString -> b) -> Serial b
readOnly :: forall b. (ByteString -> b) -> Serial b
readOnly ByteString -> b
f = forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> b
f)
stdSerial :: (Show s, Read s) => Serial s
stdSerial :: forall s. (Show s, Read s) => Serial s
stdSerial = forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (forall a. a -> Maybe a
Justforall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
P.packforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show) (forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readMforall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> String
P.unpack)
mapSerial :: (Ord k, Show k, Show v, Read k, Read v) => Serial (Map k v)
mapSerial :: forall k v.
(Ord k, Show k, Show v, Read k, Read v) =>
Serial (Map k v)
mapSerial = Serial {
serialize :: Map k v -> Maybe ByteString
serialize = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
P.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList,
deserialize :: ByteString -> Maybe (Map k v)
deserialize = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
P.unpack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
P.lines
}
readM :: (MonadFail m, Read a) => String -> m a
readM :: forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
s = case [a
x | (a
x,String
t) <- {-# SCC "Serial.readM.reads" #-} forall a. Read a => ReadS a
reads String
s
, (String
"",String
"") <- ReadS String
lex String
t] of
[a
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Serial.readM: no parse"
[a]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Serial.readM: ambiguous parse"
class Packable t where
readPacked :: ByteString -> t
showPacked :: t -> ByteString
instance Packable (Map ByteString [ByteString]) where
readPacked :: ByteString -> Map ByteString [ByteString]
readPacked ByteString
ps = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ByteString] -> [(ByteString, [ByteString])]
readKV ( ByteString -> [ByteString]
P.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
gunzip forall a b. (a -> b) -> a -> b
$ ByteString
ps))
where
readKV :: [ByteString] -> [(ByteString,[ByteString])]
readKV :: [ByteString] -> [(ByteString, [ByteString])]
readKV [] = []
readKV (ByteString
k:[ByteString]
rest) = let ([ByteString]
vs, [ByteString]
rest') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== ByteString
P.empty) [ByteString]
rest
in (ByteString
k,[ByteString]
vs) forall a. a -> [a] -> [a]
: [ByteString] -> [(ByteString, [ByteString])]
readKV (forall a. Int -> [a] -> [a]
drop Int
1 [ByteString]
rest')
showPacked :: Map ByteString [ByteString] -> ByteString
showPacked Map ByteString [ByteString]
m = ByteString -> ByteString
gzip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
P.unlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ByteString
k,[ByteString]
vs) -> ByteString
k forall a. a -> [a] -> [a]
: [ByteString]
vs forall a. [a] -> [a] -> [a]
++ [ByteString
P.empty]) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map ByteString [ByteString]
m
instance Packable (Map ByteString ByteString) where
readPacked :: ByteString -> Map ByteString ByteString
readPacked ByteString
ps = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ByteString] -> [(ByteString, ByteString)]
readKV (ByteString -> [ByteString]
P.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
gunzip forall a b. (a -> b) -> a -> b
$ ByteString
ps))
where
readKV :: [ByteString] -> [(ByteString,ByteString)]
readKV :: [ByteString] -> [(ByteString, ByteString)]
readKV [] = []
readKV (ByteString
k:ByteString
v:[ByteString]
rest) = (ByteString
k,ByteString
v) forall a. a -> [a] -> [a]
: [ByteString] -> [(ByteString, ByteString)]
readKV [ByteString]
rest
readKV [ByteString]
_ = forall a. HasCallStack => String -> a
error String
"Serial.readPacked: parse failed"
showPacked :: Map ByteString ByteString -> ByteString
showPacked Map ByteString ByteString
m = ByteString -> ByteString
gzipforall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
P.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ByteString
k,ByteString
v) -> [ByteString
k,ByteString
v]) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map ByteString ByteString
m
instance Packable ([(ByteString,ByteString)]) where
readPacked :: ByteString -> [(ByteString, ByteString)]
readPacked ByteString
ps = [ByteString] -> [(ByteString, ByteString)]
readKV (ByteString -> [ByteString]
P.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
gunzip forall a b. (a -> b) -> a -> b
$ ByteString
ps)
where
readKV :: [ByteString] -> [(ByteString,ByteString)]
readKV :: [ByteString] -> [(ByteString, ByteString)]
readKV [] = []
readKV (ByteString
k:ByteString
v:[ByteString]
rest) = (ByteString
k,ByteString
v) forall a. a -> [a] -> [a]
: [ByteString] -> [(ByteString, ByteString)]
readKV [ByteString]
rest
readKV [ByteString]
_ = forall a. HasCallStack => String -> a
error String
"Serial.readPacked: parse failed"
showPacked :: [(ByteString, ByteString)] -> ByteString
showPacked = ByteString -> ByteString
gzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
P.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ByteString
k,ByteString
v) -> [ByteString
k,ByteString
v])
instance Packable (M.Map P.ByteString (Bool, [(P.ByteString, Int)])) where
readPacked :: ByteString -> Map ByteString (Bool, [(ByteString, Int)])
readPacked = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, (Bool, [(ByteString, Int)]))]
readKV forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
P.lines
where
readKV :: [P.ByteString] -> [(P.ByteString,(Bool, [(P.ByteString, Int)]))]
readKV :: [ByteString] -> [(ByteString, (Bool, [(ByteString, Int)]))]
readKV [] = []
readKV (ByteString
k:ByteString
v:[ByteString]
rest) = (ByteString
k, (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
P.unpack) ByteString
v) forall a. a -> [a] -> [a]
: [ByteString] -> [(ByteString, (Bool, [(ByteString, Int)]))]
readKV [ByteString]
rest
readKV [ByteString]
_ = forall a. HasCallStack => String -> a
error String
"Vote.readPacked: parse failed"
showPacked :: Map ByteString (Bool, [(ByteString, Int)]) -> ByteString
showPacked Map ByteString (Bool, [(ByteString, Int)])
m = [ByteString] -> ByteString
P.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ByteString
k,(Bool, [(ByteString, Int)])
v) -> [ByteString
k,String -> ByteString
P.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ (Bool, [(ByteString, Int)])
v]) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map ByteString (Bool, [(ByteString, Int)])
m
mapPackedSerial :: Serial (Map ByteString ByteString)
mapPackedSerial :: Serial (Map ByteString ByteString)
mapPackedSerial = forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => t -> ByteString
showPacked) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => ByteString -> t
readPacked)
mapListPackedSerial :: Serial (Map ByteString [ByteString])
mapListPackedSerial :: Serial (Map ByteString [ByteString])
mapListPackedSerial = forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => t -> ByteString
showPacked) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => ByteString -> t
readPacked)
assocListPackedSerial :: Serial ([(ByteString,ByteString)])
assocListPackedSerial :: Serial [(ByteString, ByteString)]
assocListPackedSerial = forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => t -> ByteString
showPacked) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => ByteString -> t
readPacked)