-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Apply some transformations to Michelson code.

module Morley.Michelson.Preprocess
  ( transformStrings
  , transformBytes
  ) where

import Data.Default (def)

import Morley.Michelson.Text (MText)
import Morley.Michelson.Typed

-- Note: we may add such transformation for long bytestrings as well if deemed necessary.
-- And for other constants which may be arbitrarily large (e. g. lists).
-- For now we need it only for strings and probably won't need for anything else.

-- | Transform all strings in a typed instructions using given
-- function. The first argument specifies whether we should go into
-- arguments that contain instructions.
transformStrings :: Bool -> (MText -> MText) -> Instr inp out -> Instr inp out
transformStrings :: Bool -> (MText -> MText) -> Instr inp out -> Instr inp out
transformStrings Bool
goToValues MText -> MText
f = Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
forall (inp :: [T]) (out :: [T]).
Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants Bool
goToValues forall (t :: T). Value t -> Value t
mapStr
  where
    mapStr :: Value t -> Value t
    mapStr :: Value t -> Value t
mapStr = \case
      VString MText
str -> MText -> Value' Instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString (MText -> Value' Instr 'TString) -> MText -> Value' Instr 'TString
forall a b. (a -> b) -> a -> b
$ MText -> MText
f MText
str
      Value t
v -> Value t
v

-- | Similar to 'transformStrings' but for bytes.
transformBytes :: Bool -> (ByteString -> ByteString) -> Instr inp out -> Instr inp out
transformBytes :: Bool
-> (ByteString -> ByteString) -> Instr inp out -> Instr inp out
transformBytes Bool
goToValues ByteString -> ByteString
f = Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
forall (inp :: [T]) (out :: [T]).
Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants Bool
goToValues forall (t :: T). Value t -> Value t
mapBytes
  where
    mapBytes :: Value t -> Value t
    mapBytes :: Value t -> Value t
mapBytes = \case
      VBytes ByteString
bytes -> ByteString -> Value' Instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value' Instr 'TBytes)
-> ByteString -> Value' Instr 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
f ByteString
bytes
      Value t
v -> Value t
v

transformConstants ::
     forall inp out.
     Bool
  -> (forall t. Value t -> Value t)
  -- ^ Should transform only atomic values, 'dfsMapValue' will be applied to it.
  -> Instr inp out
  -> Instr inp out
transformConstants :: Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants Bool
dsGoToValues forall (t :: T). Value t -> Value t
f = (Instr inp out, ()) -> Instr inp out
forall a b. (a, b) -> a
fst ((Instr inp out, ()) -> Instr inp out)
-> (Instr inp out -> (Instr inp out, ()))
-> Instr inp out
-> Instr inp out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DfsSettings ()
-> (forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, ()))
-> Instr inp out
-> (Instr inp out, ())
forall x (inp :: [T]) (out :: [T]).
Semigroup x =>
DfsSettings x
-> (forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, x))
-> Instr inp out
-> (Instr inp out, x)
dfsInstr DfsSettings ()
forall a. Default a => a
def{ Bool
dsGoToValues :: Bool
dsGoToValues :: Bool
dsGoToValues } forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, ())
step
  where
    step :: forall i o. Instr i o -> (Instr i o, ())
    step :: Instr i o -> (Instr i o, ())
step = (,()) (Instr i o -> (Instr i o, ()))
-> (Instr i o -> Instr i o) -> Instr i o -> (Instr i o, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      PUSH Value' Instr t
v -> Value' Instr t -> Instr i (t : i)
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH ((forall (t :: T). Value t -> Value t)
-> Value' Instr t -> Value' Instr t
forall (t :: T).
(forall (t :: T). Value t -> Value t) -> Value t -> Value t
dfsMapValue forall (t :: T). Value t -> Value t
f Value' Instr t
v)
      Instr i o
i -> Instr i o
i