module Lorentz.Layouts.NonDupable
( deriveSemiDupableGeneric
) where
import Language.Haskell.TH qualified as TH
import Lorentz.ADT (HasDupableGetters)
import Morley.Util.CustomGeneric
import Morley.Util.TH
deriveSemiDupableGeneric :: String -> Int -> TH.DecsQ
deriveSemiDupableGeneric :: String -> Int -> DecsQ
deriveSemiDupableGeneric String
tyCtor Int
nonDupableFieldsNum = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> DecsQ) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> a -> b
$ [DecsQ] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ String -> GenericStrategy -> DecsQ
customGeneric String
tyCtor (Int -> GenericStrategy
semiDupableGenericStrategy Int
nonDupableFieldsNum)
, [d| instance HasDupableGetters $(addTypeVariables =<< lookupTypeNameOrFail tyCtor) |]
]
semiDupableGenericStrategy :: Int -> GenericStrategy
semiDupableGenericStrategy :: Int -> GenericStrategy
semiDupableGenericStrategy Int
nonDupableFieldsNum =
((Int -> [Natural]) -> (Int -> [Natural]) -> GenericStrategy
fromDepthsStrategy'
Int -> [Natural]
makeRightBalDepths
(\Int
n -> (Int -> [Natural]) -> Int -> Int -> [Natural]
makeSplittedDepths Int -> [Natural]
makeRightBalDepths (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nonDupableFieldsNum) Int
n))
makeSplittedDepths :: (Int -> [Natural]) -> Int -> (Int -> [Natural])
makeSplittedDepths :: (Int -> [Natural]) -> Int -> Int -> [Natural]
makeSplittedDepths Int -> [Natural]
mkInnerDepths Int
leftN Int
n
| Int
leftN Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Int
leftN Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Int -> [Natural]
mkInnerDepths Int
n
| Bool
otherwise = (Natural -> Natural) -> [Natural] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Natural
forall a. Enum a => a -> a
succ ([Natural] -> [Natural]) -> [Natural] -> [Natural]
forall a b. (a -> b) -> a -> b
$ Int -> [Natural]
mkInnerDepths Int
leftN [Natural] -> [Natural] -> [Natural]
forall a. [a] -> [a] -> [a]
++ Int -> [Natural]
mkInnerDepths (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftN)