{-# 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 :: forall a. Parser a -> Parser a
parens Parser a
p = Char -> Parser Char
A.char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
')'

brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets Parser a
p = Char -> Parser Char
A.char Char
'[' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p 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 :: forall a. Text -> Parser a -> Parser a
application Text
fname Parser a
p = Text -> Parser Text
A.string Text
fname forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Parser a -> Parser a
parens (forall a. Parser a -> Parser a
spacePadded Parser a
p)

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

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

argList :: Parser a -> Parser [a]
argList :: forall a. Parser a -> Parser [a]
argList Parser a
p = forall a. Parser a -> Parser a
spacePadded Parser a
p 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
A.letter

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

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

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

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

maybeFail :: String -> (a -> b) -> Maybe a -> Parser b
maybeFail :: forall a b. [Char] -> (a -> b) -> Maybe a -> Parser b
maybeFail [Char]
msg a -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg) (forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall r c e.
(r -> Map Text c) -> e -> Text -> ReaderT r (Except e) c
requiredContextValue r -> Map Text c
f e
e Text
name = forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Map Text c
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e) forall (m :: * -> *) a. Monad m => a -> m a
return