module Network.Haskoin.Util
(
bsToInteger
, integerToBS
, encodeHex
, decodeHex
, isLeft
, isRight
, fromRight
, fromLeft
, eitherToMaybe
, maybeToEither
, liftEither
, liftMaybe
, decodeToMaybe
, updateIndex
, matchTemplate
, fst3
, snd3
, lst3
, modify'
, dropFieldLabel
, dropSumLabels
) where
import Control.Monad (guard)
import Control.Monad.Trans.Either (EitherT, hoistEither)
import Control.Monad.State (MonadState, get, put)
import Data.Serialize (Serialize, decode)
import Data.Word (Word8)
import Data.Bits ((.|.), shiftL, shiftR)
import Data.Char (toLower)
import Data.Aeson.Types
(Options(..), SumEncoding(..), defaultOptions, defaultTaggedObject)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as BS
(pack, empty, foldr', reverse, unfoldr)
bsToInteger :: ByteString -> Integer
bsToInteger = BS.foldr' f 0 . BS.reverse
where
f w n = toInteger w .|. shiftL n 8
integerToBS :: Integer -> ByteString
integerToBS 0 = BS.pack [0]
integerToBS i
| i > 0 = BS.reverse $ BS.unfoldr f i
| otherwise = error "integerToBS not defined for negative values"
where
f 0 = Nothing
f x = Just (fromInteger x :: Word8, x `shiftR` 8)
encodeHex :: ByteString -> ByteString
encodeHex = B16.encode
decodeHex :: ByteString -> Maybe ByteString
decodeHex bs =
let (x, b) = B16.decode bs
in guard (b == BS.empty) >> return x
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 = maybe (Left err) Right
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
decodeToMaybe :: Serialize a => ByteString -> Maybe a
decodeToMaybe bs = eitherToMaybe $ decode bs
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 (`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
modify' :: MonadState s m => (s -> s) -> m ()
modify' f = get >>= \x -> put $! f x
dropFieldLabel :: Int -> Options
dropFieldLabel n = defaultOptions
{ fieldLabelModifier = map toLower . drop n
, omitNothingFields = False
}
dropSumLabels :: Int -> Int -> String -> Options
dropSumLabels c f tag = (dropFieldLabel f)
{ constructorTagModifier = map toLower . drop c
, sumEncoding = defaultTaggedObject { tagFieldName = tag }
}