-- 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 n :: 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 (\(_, p :: Int
p) -> Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) [(Natural, Int)]
powersOfTwo of
        Nothing -> []
        Just (depth :: Natural
depth, power :: 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 = [0..] [Natural] -> (Natural -> (Natural, Int)) -> [(Natural, Int)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \i :: Natural
i -> (Natural
i, 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'.
ligoCombLayout :: GenericStrategy
ligoCombLayout :: GenericStrategy
ligoCombLayout = GenericStrategy
rightComb