module Network.Haskoin.Util
(
toStrictBS
, toLazyBS
, stringToBS
, bsToString
, bsToInteger
, integerToBS
, bsToHex
, hexToBS
, encode'
, decode'
, runPut'
, runGet'
, decodeOrFail'
, runGetOrFail'
, fromDecode
, fromRunGet
, decodeToEither
, decodeToMaybe
, isolate
, isLeft
, isRight
, fromRight
, fromLeft
, eitherToMaybe
, maybeToEither
, liftEither
, liftMaybe
, updateIndex
, matchTemplate
, fst3
, snd3
, lst3
) where
import Numeric (readHex)
import Control.Applicative ((<$>))
import Control.Monad (guard)
import Control.Monad.Trans.Either (EitherT, hoistEither)
import Data.Word (Word8)
import Data.Bits ((.|.), shiftL, shiftR)
import Data.List (unfoldr)
import Data.List.Split (chunksOf)
import Data.Binary.Put (Put, runPut)
import Data.Binary
( Binary
, encode
, decode
, decodeOrFail
)
import Data.Binary.Get
( Get
, runGetOrFail
, getByteString
, ByteOffset
, runGet
)
import qualified Data.ByteString.Lazy as BL
( ByteString
, toChunks
, fromChunks
)
import qualified Data.ByteString as BS
( ByteString
, concat
, pack, unpack
, null
)
import qualified Data.ByteString.Builder as BSB
( toLazyByteString
, byteStringHex
)
import qualified Data.ByteString.Char8 as C
( pack
, unpack
)
toStrictBS :: BL.ByteString -> BS.ByteString
toStrictBS = BS.concat . BL.toChunks
toLazyBS :: BS.ByteString -> BL.ByteString
toLazyBS bs = BL.fromChunks [bs]
stringToBS :: String -> BS.ByteString
stringToBS = C.pack
bsToString :: BS.ByteString -> String
bsToString = C.unpack
bsToInteger :: BS.ByteString -> Integer
bsToInteger = (foldr f 0) . reverse . BS.unpack
where
f w n = (toInteger w) .|. shiftL n 8
integerToBS :: Integer -> BS.ByteString
integerToBS 0 = BS.pack [0]
integerToBS i
| i > 0 = BS.pack $ reverse $ unfoldr f i
| otherwise = error "integerToBS not defined for negative values"
where
f 0 = Nothing
f x = Just $ (fromInteger x :: Word8, x `shiftR` 8)
bsToHex :: BS.ByteString -> String
bsToHex = bsToString . toStrictBS . BSB.toLazyByteString . BSB.byteStringHex
hexToBS :: String -> Maybe BS.ByteString
hexToBS xs = BS.pack <$> mapM hexWord (chunksOf 2 xs)
where
hexWord x = do
guard $ length x == 2
let hs = readHex x
guard $ not $ null hs
let [(w, s)] = hs
guard $ null s
return w
encode' :: Binary a => a -> BS.ByteString
encode' = toStrictBS . encode
decode' :: Binary a => BS.ByteString -> a
decode' = decode . toLazyBS
runGet' :: Binary a => Get a -> BS.ByteString -> a
runGet' m = (runGet m) . toLazyBS
runPut' :: Put -> BS.ByteString
runPut' = toStrictBS . runPut
decodeOrFail' ::
Binary a =>
BS.ByteString ->
Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)
decodeOrFail' bs = case decodeOrFail $ toLazyBS bs of
Left (lbs,o,err) -> Left (toStrictBS lbs,o,err)
Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)
runGetOrFail' ::
Binary a => Get a -> BS.ByteString ->
Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)
runGetOrFail' m bs = case runGetOrFail m $ toLazyBS bs of
Left (lbs,o,err) -> Left (toStrictBS lbs,o,err)
Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)
fromDecode :: Binary a
=> BS.ByteString
-> b
-> (a -> b)
-> b
fromDecode bs def f = either (const def) (f . lst) $ decodeOrFail' bs
where
lst (_,_,c) = c
fromRunGet :: Binary a
=> Get a
-> BS.ByteString
-> b
-> (a -> b)
-> b
fromRunGet m bs def f = either (const def) (f . lst) $ runGetOrFail' m bs
where
lst (_,_,c) = c
decodeToEither :: Binary a => BS.ByteString -> Either String a
decodeToEither bs = case decodeOrFail' bs of
Left (_,_,err) -> Left err
Right (_,_,res) -> Right res
decodeToMaybe :: Binary a => BS.ByteString -> Maybe a
decodeToMaybe bs = fromDecode bs Nothing Just
isolate :: Binary a => Int -> Get a -> Get a
isolate i g = do
bs <- getByteString i
case runGetOrFail' g bs of
Left (_, _, err) -> fail err
Right (unconsumed, _, res)
| BS.null unconsumed -> return res
| otherwise -> fail "Isolate: unconsumed input"
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight _ = False
isLeft :: Either a b -> Bool
isLeft = not . isRight
fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight _ = error "Either.fromRight: Left"
fromLeft :: Either a b -> a
fromLeft (Left a) = a
fromLeft _ = error "Either.fromLeft: Right"
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe (Right b) = Just b
eitherToMaybe _ = Nothing
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither err m = maybe (Left err) Right m
liftEither :: Monad m => Either b a -> EitherT b m a
liftEither = hoistEither
liftMaybe :: Monad m => b -> Maybe a -> EitherT b m a
liftMaybe err = liftEither . (maybeToEither err)
updateIndex :: Int
-> [a]
-> (a -> a)
-> [a]
updateIndex i xs f
| i < 0 || i >= length xs = xs
| otherwise = l ++ (f h : r)
where
(l,h:r) = splitAt i xs
matchTemplate :: [a]
-> [b]
-> (a -> b -> Bool)
-> [Maybe a]
matchTemplate [] bs _ = replicate (length bs) Nothing
matchTemplate _ [] _ = []
matchTemplate as (b:bs) f = case break (flip f b) as of
(l,(r:rs)) -> (Just r) : matchTemplate (l ++ rs) bs f
_ -> Nothing : matchTemplate as bs f
fst3 :: (a,b,c) -> a
fst3 (a,_,_) = a
snd3 :: (a,b,c) -> b
snd3 (_,b,_) = b
lst3 :: (a,b,c) -> c
lst3 (_,_,c) = c