{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Produce a text representation of Miniscript expressions
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
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 -> Int -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
    Older Value Int
n -> Text -> Text -> Text
applicationText Text
"older" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
    After Value Int
n -> Text -> Text -> Text
applicationText Text
"after" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
    Sha256 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"sha256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Ripemd160 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"ripemd160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Hash256 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"hash256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Hash160 Value ByteString
h -> Text -> Text -> Text
applicationText Text
"hash160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    AndV Miniscript
x (Boolean Bool
True) -> Text
"t:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
    OrI (Boolean Bool
False) Miniscript
x -> Text
"l:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
    OrI Miniscript
x (Boolean Bool
False) -> Text
"u:" Text -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> Text -> Text
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" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Miniscript -> Text
toText (Miniscript -> Text) -> [Miniscript] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Miniscript
x Miniscript -> [Miniscript] -> [Miniscript]
forall a. a -> [a] -> [a]
: [Miniscript]
xs))
    Multi Value Int
n [Value KeyDescriptor]
xs ->
        Text -> Text -> Text
applicationText Text
"multi" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Value KeyDescriptor -> Text
atomicKeyDescText (Value KeyDescriptor -> Text) -> [Value KeyDescriptor] -> [Text]
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText Text
"pk" (Text -> Text) -> Text -> Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText Text
"pkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
        AnnA Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'a' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnS Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
's' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnC Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'c' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnD Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'd' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnV Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'v' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnJ Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'j' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnN Miniscript
x -> [Char] -> Miniscript -> Text
ann (Char
'n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        Miniscript
e -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Miniscript -> Text
toText Miniscript
e

    printAnn :: [Char] -> Text -> Text
printAnn [Char]
as Text
x
        | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
as = Text
x
        | Bool
otherwise = [Char] -> Text
Text.pack ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
as) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

    printList :: [Miniscript] -> Text
printList = Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text)
-> ([Miniscript] -> [Text]) -> [Miniscript] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Miniscript -> Text) -> [Miniscript] -> [Text]
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 = (Int -> Text) -> Value Int -> Text
forall t. (t -> Text) -> Value t -> Text
atomicText Int -> Text
forall a. Show a => a -> Text
showText
    atomicBytesText :: Value ByteString -> Text
atomicBytesText = (ByteString -> Text) -> Value ByteString -> Text
forall t. (t -> Text) -> Value t -> Text
atomicText ByteString -> Text
encodeHex
    atomicKeyDescText :: Value KeyDescriptor -> Text
atomicKeyDescText = (KeyDescriptor -> Text) -> Value KeyDescriptor -> Text
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