{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Bitcoin.Miniscript.Text (
miniscriptToText,
) where
import Data.Text (Text)
import qualified Data.Text as Text
import Haskoin.Constants (Network)
import Haskoin.Util (encodeHex)
import Language.Bitcoin.Miniscript.Syntax (
Miniscript (..),
Value (..),
)
import Language.Bitcoin.Script.Descriptors.Text (keyDescriptorToText)
import Language.Bitcoin.Utils (applicationText, showText)
miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText Network
net = \case
Var Text
n -> Text
n
Let Text
n Miniscript
e Miniscript
b ->
Text
"let " forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
e forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
b
Boolean Bool
True -> Text
"1"
Boolean Bool
False -> Text
"0"
Number Int
w -> forall a. Show a => a -> Text
showText Int
w
Bytes ByteString
b -> ByteString -> Text
encodeHex ByteString
b
KeyDesc KeyDescriptor
k -> Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net KeyDescriptor
k
Key Value KeyDescriptor
x -> Text -> Text -> Text
applicationText Text
"pk_k" forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
KeyH Value KeyDescriptor
x -> Text -> Text -> Text
applicationText Text
"pk_h" forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
Older Value Int
n -> Text -> Text -> Text
applicationText Text
"older" forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
After Value Int
n -> Text -> Text -> Text
applicationText Text
"after" forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
Sha256 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"sha256" forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Ripemd160 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"ripemd160" forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Hash256 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"hash256" forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Hash160 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"hash160" forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
AndV Miniscript
x (Boolean Bool
True) -> Text
"t:" forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
OrI (Boolean Bool
False) Miniscript
x -> Text
"l:" forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
OrI Miniscript
x (Boolean Bool
False) -> Text
"u:" forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
AndOr Miniscript
x Miniscript
y Miniscript
z -> Text -> Text -> Text
applicationText Text
"andor" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y, Miniscript
z]
AndV Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"and_v" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
AndB Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"and_b" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrB Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"or_b" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrC Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"or_c" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrD Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"or_d" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrI Miniscript
x Miniscript
y -> Text -> Text -> Text
applicationText Text
"or_i" forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
Thresh Value Int
k Miniscript
x [Miniscript]
xs ->
Text -> Text -> Text
applicationText Text
"thresh" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
k forall a. a -> [a] -> [a]
: (Miniscript -> Text
toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Miniscript
x forall a. a -> [a] -> [a]
: [Miniscript]
xs))
Multi Value Int
n [Value KeyDescriptor]
xs ->
Text -> Text -> Text
applicationText Text
"multi" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n forall a. a -> [a] -> [a]
: (Value KeyDescriptor -> Text
atomicKeyDescText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value KeyDescriptor]
xs)
Miniscript
a -> [Char] -> Miniscript -> Text
ann [Char]
"" Miniscript
a
where
ann :: [Char] -> Miniscript -> Text
ann [Char]
as = \case
AnnC (Key Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText Text
"pk" forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
AnnC (KeyH Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText Text
"pkh" forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
AnnA Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'a' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnS Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
's' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnC Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'c' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnD Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'd' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnV Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'v' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnJ Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'j' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnN Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'n' forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
Miniscript
e -> [Char] -> Text -> Text
printAnn [Char]
as forall a b. (a -> b) -> a -> b
$ Miniscript -> Text
toText Miniscript
e
printAnn :: [Char] -> Text -> Text
printAnn [Char]
as Text
x
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
as = Text
x
| Bool
otherwise = [Char] -> Text
Text.pack (forall a. [a] -> [a]
reverse [Char]
as) forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
x
printList :: [Miniscript] -> Text
printList = Text -> [Text] -> Text
Text.intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Miniscript -> Text
toText
toText :: Miniscript -> Text
toText = Network -> Miniscript -> Text
miniscriptToText Network
net
atomicNumberText :: Value Int -> Text
atomicNumberText = forall {t}. (t -> Text) -> Value t -> Text
atomicText forall a. Show a => a -> Text
showText
atomicBytesText :: Value ByteString -> Text
atomicBytesText = forall {t}. (t -> Text) -> Value t -> Text
atomicText ByteString -> Text
encodeHex
atomicKeyDescText :: Value KeyDescriptor -> Text
atomicKeyDescText = forall {t}. (t -> Text) -> Value t -> Text
atomicText (Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net)
atomicText :: (t -> Text) -> Value t -> Text
atomicText t -> Text
f = \case
Variable Text
name -> Text
name
Lit t
x -> t -> Text
f t
x