{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module NixOverlays where

import Data.Foldable (foldl')
import Data.Function (fix)
import qualified Data.HashMap.Lazy as HMap
import Data.HashMap.Lazy (HashMap)
import Prelude

----
-- This bit is not important, just setting up a vague
-- AttrSet type to show the interesting bit

type Key = String

data Attr a
  = Leaf a
  | Node (AttrSet a)
  deriving stock (Show, Functor)

newtype AttrSet a = AS (HashMap Key (Attr a))
  deriving stock (Show, Functor)
  deriving newtype (Semigroup, Monoid)

find :: AttrSet a -> Key -> Maybe (Attr a)
find (AS m) k = HMap.lookup k m

set :: AttrSet a -> Key -> Attr a -> AttrSet a
set (AS m) k v = AS $ HMap.insert k v m

----
-- This is the interesting bit, how overlays work

applyOverlays :: forall a. [AttrSet a -> AttrSet a -> AttrSet a] -> AttrSet a
applyOverlays fs = fix go
  where
    go :: AttrSet a -> AttrSet a
    go self = foldl' extend mempty $ fmap (\f -> f self) fs

extend :: AttrSet a -> (AttrSet a -> AttrSet a) -> AttrSet a
extend s f = f s <> s

----
-- And an example to demonstrate it

o1, o2, o3 :: AttrSet Int -> AttrSet Int -> AttrSet Int
o1 _ _ = S $ HMap.fromList [("a", Leaf 1), ("b", Leaf 1)]
o2 self super = set super "a" $ maybe (Leaf 0) (fmap (* 2)) (find self "b")
o3 _ super = set super "b" (Leaf 2)

derivation :: AttrSet Int
derivation = applyOverlays [o1, o2, o3]

{-
λ> derivation
AS (fromList [("a",Leaf 4),("b",Leaf 2)])

Notice that "a" is 4 not 2, even though o2 was applied before o3.
This is because o2 used "self" to look up "b"-s value and used
that to set a's value. This works because "self" is the fix point
of the derivation, ie. the final result of the attribute set.

Note: Setting "self" would result in an infinite loop.
-}