{-# LANGUAGE ImpredicativeTypes #-}

-- | Support for multiple-output tasks.
module Build.Multi (Partition, multi) where

import Data.Maybe
import Build.Task

-- | Defines a set partition. For a function to be a valid partition,
--   if @f k == ks@, then:
--
-- * @k \in ks@
--
-- * @forall i \in ks . f i == ks@
type Partition k = k -> [k]

-- | Given a task description with individual multiple-output keys, compute its
-- "closure" supporting all possible combinations of keys.
multi :: Eq k => Partition k -> Tasks Applicative [k] [v] -> Tasks Applicative [k] [v]
multi :: forall k v.
Eq k =>
Partition k
-> Tasks Applicative [k] [v] -> Tasks Applicative [k] [v]
multi Partition k
partition Tasks Applicative [k] [v]
tasks [k]
keys
    | k
k:[k]
_ <- [k]
keys, Partition k
partition k
k [k] -> [k] -> Bool
forall a. Eq a => a -> a -> Bool
== [k]
keys = Tasks Applicative [k] [v]
tasks [k]
keys
    | Bool
otherwise = Task Applicative [k] [v] -> Maybe (Task Applicative [k] [v])
forall a. a -> Maybe a
Just (Task Applicative [k] [v] -> Maybe (Task Applicative [k] [v]))
-> Task Applicative [k] [v] -> Maybe (Task Applicative [k] [v])
forall a b. (a -> b) -> a -> b
$ \[k] -> f [v]
fetch ->
        [f v] -> f [v]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [ k -> [v] -> v
forall {a}. k -> [a] -> a
select k
k ([v] -> v) -> f [v] -> f v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k] -> f [v]
fetch (Partition k
partition k
k) | k
k <- [k]
keys ]
  where
    select :: k -> [a] -> a
select k
k = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
msg) (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> [(k, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
k ([(k, a)] -> Maybe a) -> ([a] -> [(k, a)]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Partition k
partition k
k)
    msg :: [Char]
msg = [Char]
"Partition invariants violated"