{-# 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 " 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