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

-- | Compatibility of Haskell values representation in Michelson.
module Michelson.Typed.Haskell.Compatibility
  ( ligoLayout
  , ligoCombLayout
  ) where

import Util.CustomGeneric

-- | Default layout in LIGO.
--
-- To be used with 'customGeneric', see this method for more info.
--
-- This is similar to 'leftBalanced', but
--
-- * fields are sorted alphabetically;
-- * always puts as large complete binary subtrees as possible at left.
ligoLayout :: GenericStrategy
ligoLayout :: GenericStrategy
ligoLayout =
  UnnamedEntriesReorder
-> EntriesReorder -> GenericStrategy -> GenericStrategy
reorderingData UnnamedEntriesReorder
forbidUnnamedFields EntriesReorder
alphabetically (GenericStrategy -> GenericStrategy)
-> GenericStrategy -> GenericStrategy
forall a b. (a -> b) -> a -> b
$
    (Int -> [Natural]) -> GenericStrategy
fromDepthsStrategy Int -> [Natural]
ligoDepths
  where
    ligoDepths :: Int -> [Natural]
ligoDepths Int
n =
      case (NonEmpty (Natural, Int) -> (Natural, Int))
-> Maybe (NonEmpty (Natural, Int)) -> Maybe (Natural, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Natural, Int) -> (Natural, Int)
forall a. NonEmpty a -> a
last (Maybe (NonEmpty (Natural, Int)) -> Maybe (Natural, Int))
-> ([(Natural, Int)] -> Maybe (NonEmpty (Natural, Int)))
-> [(Natural, Int)]
-> Maybe (Natural, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Natural, Int)] -> Maybe (NonEmpty (Natural, Int))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(Natural, Int)] -> Maybe (Natural, Int))
-> [(Natural, Int)] -> Maybe (Natural, Int)
forall a b. (a -> b) -> a -> b
$ ((Natural, Int) -> Bool) -> [(Natural, Int)] -> [(Natural, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Natural
_, Int
p) -> Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) [(Natural, Int)]
powersOfTwo of
        Maybe (Natural, Int)
Nothing -> []
        Just (Natural
depth, Int
power) ->
          let leftSub :: [Natural]
leftSub = Int -> Natural -> [Natural]
forall a. Int -> a -> [a]
replicate Int
power Natural
depth
              rightSub :: [Natural]
rightSub = Int -> [Natural]
ligoDepths (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
power)
          in if [Natural] -> Bool
forall t. Container t => t -> Bool
null [Natural]
rightSub then [Natural]
leftSub else (Natural -> Natural) -> [Natural] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Natural -> Natural
forall a. Enum a => a -> a
succ ([Natural] -> [Natural]) -> [Natural] -> [Natural]
forall a b. (a -> b) -> a -> b
$ [Natural]
leftSub [Natural] -> [Natural] -> [Natural]
forall a. [a] -> [a] -> [a]
++ [Natural]
rightSub

    powersOfTwo :: [(Natural, Int)]
powersOfTwo = [Natural
0..] [Natural] -> (Natural -> (Natural, Int)) -> [(Natural, Int)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Natural
i -> (Natural
i, Int
2 Int -> Natural -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Natural
i)

-- | Comb layout in LIGO (@ [\@layout:comb] @).
--
-- To be used with 'customGeneric'.
--
-- Note: to make comb layout work for sum types, make sure that in LIGO
-- all the constructors are preceded by the bar symbol in your type declaration:
--
-- @
-- type my_type =
--   [@layout:comb]
--   | Ctor1 of nat  ← bar symbol _must_ be here
--   | Ctor2 of int
--   ...
-- @
--
-- Though the situation may change: https://gitlab.com/ligolang/ligo/-/issues/1104.
ligoCombLayout :: GenericStrategy
ligoCombLayout :: GenericStrategy
ligoCombLayout = GenericStrategy
rightComb