{-# 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 (keyDescriptorToText)
import Language.Bitcoin.Utils (applicationText, showText)

miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText net :: Network
net = \case
    Var n :: Text
n -> Text
n
    Let n :: Text
n e :: Miniscript
e b :: Miniscript
b ->
        "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
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
<> " in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
b
    Boolean True -> "1"
    Boolean False -> "0"
    Number w :: Int
w -> Int -> Text
forall a. Show a => a -> Text
showText Int
w
    Bytes b :: ByteString
b -> ByteString -> Text
encodeHex ByteString
b
    KeyDesc k :: KeyDescriptor
k -> Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net KeyDescriptor
k
    Key x :: Value KeyDescriptor
x -> Text -> Text -> Text
applicationText "pk_k" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
    KeyH x :: Value KeyDescriptor
x -> Text -> Text -> Text
applicationText "pk_h" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
    Older n :: Value Int
n -> Text -> Text -> Text
applicationText "older" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
    After n :: Value Int
n -> Text -> Text -> Text
applicationText "after" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
    Sha256 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "sha256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Ripemd160 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "ripemd160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Hash256 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "hash256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    Hash160 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "hash160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
    AndV x :: Miniscript
x (Boolean True) -> "t:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
    OrI (Boolean False) x :: Miniscript
x -> "l:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
    OrI x :: Miniscript
x (Boolean False) -> "u:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
    AndOr x :: Miniscript
x y :: Miniscript
y z :: Miniscript
z -> Text -> Text -> Text
applicationText "andor" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y, Miniscript
z]
    AndV x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "and_v" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    AndB x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "and_b" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    OrB x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_b" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    OrC x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_c" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    OrD x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_d" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    OrI x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_i" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
    Thresh k :: Value Int
k x :: Miniscript
x xs :: [Miniscript]
xs ->
        Text -> Text -> Text
applicationText "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
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 n :: Value Int
n xs :: [Value KeyDescriptor]
xs ->
        Text -> Text -> Text
applicationText "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
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)
    a :: Miniscript
a -> [Char] -> Miniscript -> Text
ann "" Miniscript
a
  where
    ann :: [Char] -> Miniscript -> Text
ann as :: [Char]
as = \case
        AnnC (Key x :: Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText "pk" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
        AnnC (KeyH x :: Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText "pkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
        AnnA x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('a' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnS x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('s' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnC x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('c' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnD x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('d' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnV x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('v' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnJ x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('j' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        AnnN x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
        e :: 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 as :: [Char]
as x :: 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
forall a. Semigroup a => a -> a -> a
<> Text
x

    printList :: [Miniscript] -> Text
printList = Text -> [Text] -> Text
Text.intercalate "," ([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 f :: t -> Text
f = \case
        Variable name :: Text
name -> Text
name
        Lit x :: t
x -> t -> Text
f t
x