{-# LANGUAGE OverloadedStrings #-}

-- |  Various parsing and printing utilities
module Language.Bitcoin.Utils (
    parens,
    brackets,
    application,
    hex,
    comma,
    argList,
    alphanum,
    spacePadded,
    showText,
    applicationText,
    requiredContextValue,
    maybeFail,
) where

import Control.Applicative ((<|>))
import Control.Monad (void)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (Except, throwE)
import Control.Monad.Trans.Reader (ReaderT, asks)
import Data.Attoparsec.Text (Parser)
import qualified Data.Attoparsec.Text as A
import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text, pack)
import Haskoin.Util (decodeHex)

parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens Parser a
p = Char -> Parser Char
A.char Char
'(' Parser Char -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p Parser a -> Parser Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
')'

brackets :: Parser a -> Parser a
brackets :: Parser a -> Parser a
brackets Parser a
p = Char -> Parser Char
A.char Char
'[' Parser Char -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p Parser a -> Parser Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
']'

application :: Text -> Parser a -> Parser a
application :: Text -> Parser a -> Parser a
application Text
fname Parser a
p = Text -> Parser Text
A.string Text
fname Parser Text -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> Parser a
forall a. Parser a -> Parser a
parens (Parser a -> Parser a
forall a. Parser a -> Parser a
spacePadded Parser a
p)

hex :: Parser ByteString
hex :: Parser ByteString
hex = Parser Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many1' Parser Char
hexChar Parser Text [Char]
-> ([Char] -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char]
-> (ByteString -> ByteString)
-> Maybe ByteString
-> Parser ByteString
forall a b. [Char] -> (a -> b) -> Maybe a -> Parser b
maybeFail [Char]
"Invalid hex" ByteString -> ByteString
forall a. a -> a
id (Maybe ByteString -> Parser ByteString)
-> ([Char] -> Maybe ByteString) -> [Char] -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString)
-> ([Char] -> Text) -> [Char] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack
  where
    hexChar :: Parser Char
hexChar = (Char -> Bool) -> Parser Char
A.satisfy ((Char -> Bool) -> Parser Char) -> (Char -> Bool) -> Parser Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Char -> Bool
A.inClass [Char]
chars
    chars :: [Char]
chars = [Char
'0' .. Char
'9'] [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char
'a' .. Char
'f'] [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char
'A' .. Char
'F']

-- | Allow for a leading comma
comma :: Parser a -> Parser a
comma :: Parser a -> Parser a
comma Parser a
p = Parser Char -> Parser Char
forall a. Parser a -> Parser a
spacePadded (Char -> Parser Char
A.char Char
',') Parser Char -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p

argList :: Parser a -> Parser [a]
argList :: Parser a -> Parser [a]
argList Parser a
p = Parser a -> Parser a
forall a. Parser a -> Parser a
spacePadded Parser a
p Parser a -> Parser Char -> Parser [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` Char -> Parser Char
A.char Char
','

alphanum :: Parser Char
alphanum :: Parser Char
alphanum = Parser Char
A.digit Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
A.letter

spacePadded :: Parser a -> Parser a
spacePadded :: Parser a -> Parser a
spacePadded Parser a
p = Parser ()
spaces Parser () -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaces

spaces :: Parser ()
spaces :: Parser ()
spaces = Parser Text [Char] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text [Char] -> Parser ())
-> Parser Text [Char] -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' Parser Char
A.space

showText :: Show a => a -> Text
showText :: a -> Text
showText = [Char] -> Text
pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

applicationText :: Text -> Text -> Text
applicationText :: Text -> Text -> Text
applicationText Text
f Text
x = Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

maybeFail :: String -> (a -> b) -> Maybe a -> Parser b
maybeFail :: [Char] -> (a -> b) -> Maybe a -> Parser b
maybeFail [Char]
msg a -> b
f = Parser b -> (a -> Parser b) -> Maybe a -> Parser b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser b
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg) (b -> Parser b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Parser b) -> (a -> b) -> a -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

requiredContextValue :: (r -> Map Text c) -> e -> Text -> ReaderT r (Except e) c
requiredContextValue :: (r -> Map Text c) -> e -> Text -> ReaderT r (Except e) c
requiredContextValue r -> Map Text c
f e
e Text
name = (r -> Maybe c) -> ReaderT r (Except e) (Maybe c)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (Text -> Map Text c -> Maybe c
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (Map Text c -> Maybe c) -> (r -> Map Text c) -> r -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Map Text c
f) ReaderT r (Except e) (Maybe c)
-> (Maybe c -> ReaderT r (Except e) c) -> ReaderT r (Except e) c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT r (Except e) c
-> (c -> ReaderT r (Except e) c)
-> Maybe c
-> ReaderT r (Except e) c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExceptT e Identity c -> ReaderT r (Except e) c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT e Identity c -> ReaderT r (Except e) c)
-> ExceptT e Identity c -> ReaderT r (Except e) c
forall a b. (a -> b) -> a -> b
$ e -> ExceptT e Identity c
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e) c -> ReaderT r (Except e) c
forall (m :: * -> *) a. Monad m => a -> m a
return