{-# LANGUAGE FlexibleContexts, TypeFamilies #-}

module Data.Deps (
	Deps(..), depsMap,
	mapDeps,
	dep, deps,
	inverse,
	DepsError(..), flatten,
	selfDepend,
	linearize
	) where

import Control.Lens
import Control.Monad.State
import Control.Monad.Except
import Data.List (nub, intercalate)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Semigroup
import Data.Maybe (fromMaybe)

-- | Dependency map
newtype Deps a = Deps {
	Deps a -> Map a [a]
_depsMap :: Map a [a] }

depsMap :: Lens (Deps a) (Deps b) (Map a [a]) (Map b [b])
depsMap :: (Map a [a] -> f (Map b [b])) -> Deps a -> f (Deps b)
depsMap = (Deps a -> Map a [a])
-> (Deps a -> Map b [b] -> Deps b)
-> Lens (Deps a) (Deps b) (Map a [a]) (Map b [b])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Deps a -> Map a [a]
forall a. Deps a -> Map a [a]
_depsMap ((Map b [b] -> Deps b) -> Deps a -> Map b [b] -> Deps b
forall a b. a -> b -> a
const Map b [b] -> Deps b
forall a. Map a [a] -> Deps a
Deps)

instance Ord a => Semigroup (Deps a) where
	Deps Map a [a]
l <> :: Deps a -> Deps a -> Deps a
<> Deps Map a [a]
r = Map a [a] -> Deps a
forall a. Map a [a] -> Deps a
Deps (Map a [a] -> Deps a) -> Map a [a] -> Deps a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> Map a [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
nubConcat Map a [a]
l Map a [a]
r

instance Ord a => Monoid (Deps a) where
	mempty :: Deps a
mempty = Map a [a] -> Deps a
forall a. Map a [a] -> Deps a
Deps Map a [a]
forall a. Monoid a => a
mempty
	mappend :: Deps a -> Deps a -> Deps a
mappend (Deps Map a [a]
l) (Deps Map a [a]
r) = Map a [a] -> Deps a
forall a. Map a [a] -> Deps a
Deps (Map a [a] -> Deps a) -> Map a [a] -> Deps a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> Map a [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
nubConcat Map a [a]
l Map a [a]
r

instance Show a => Show (Deps a) where
	show :: Deps a -> String
show (Deps Map a [a]
ds) = [String] -> String
unlines [a -> String
forall a. Show a => a -> String
show a
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
s) | (a
d, [a]
s) <- Map a [a] -> [(a, [a])]
forall k a. Map k a -> [(k, a)]
M.toList Map a [a]
ds]

type instance Index (Deps a) = a
type instance IxValue (Deps a) = [a]

instance Ord a => Ixed (Deps a) where
	ix :: Index (Deps a) -> Traversal' (Deps a) (IxValue (Deps a))
ix Index (Deps a)
k = (Map a [a] -> f (Map a [a])) -> Deps a -> f (Deps a)
forall a b. Lens (Deps a) (Deps b) (Map a [a]) (Map b [b])
depsMap ((Map a [a] -> f (Map a [a])) -> Deps a -> f (Deps a))
-> (([a] -> f [a]) -> Map a [a] -> f (Map a [a]))
-> ([a] -> f [a])
-> Deps a
-> f (Deps a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map a [a]) -> Traversal' (Map a [a]) (IxValue (Map a [a]))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map a [a])
Index (Deps a)
k

instance Ord a => At (Deps a) where
	at :: Index (Deps a) -> Lens' (Deps a) (Maybe (IxValue (Deps a)))
at Index (Deps a)
k = (Map a [a] -> f (Map a [a])) -> Deps a -> f (Deps a)
forall a b. Lens (Deps a) (Deps b) (Map a [a]) (Map b [b])
depsMap ((Map a [a] -> f (Map a [a])) -> Deps a -> f (Deps a))
-> ((Maybe [a] -> f (Maybe [a])) -> Map a [a] -> f (Map a [a]))
-> (Maybe [a] -> f (Maybe [a]))
-> Deps a
-> f (Deps a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map a [a])
-> Lens' (Map a [a]) (Maybe (IxValue (Map a [a])))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map a [a])
Index (Deps a)
k

mapDeps :: Ord b => (a -> b) -> Deps a -> Deps b
mapDeps :: (a -> b) -> Deps a -> Deps b
mapDeps a -> b
f = Map b [b] -> Deps b
forall a. Map a [a] -> Deps a
Deps (Map b [b] -> Deps b) -> (Deps a -> Map b [b]) -> Deps a -> Deps b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Map a [b] -> Map b [b]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys a -> b
f (Map a [b] -> Map b [b])
-> (Deps a -> Map a [b]) -> Deps a -> Map b [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [b]) -> Map a [a] -> Map a [b]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) (Map a [a] -> Map a [b])
-> (Deps a -> Map a [a]) -> Deps a -> Map a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps a -> Map a [a]
forall a. Deps a -> Map a [a]
_depsMap

-- | Make single dependency
dep :: a -> a -> Deps a
dep :: a -> a -> Deps a
dep a
x a
y = a -> [a] -> Deps a
forall a. a -> [a] -> Deps a
deps a
x [a
y]

-- | Make dependency for one target, note that order of dependencies is matter
deps :: a -> [a] -> Deps a
deps :: a -> [a] -> Deps a
deps a
x [a]
ys = Map a [a] -> Deps a
forall a. Map a [a] -> Deps a
Deps (Map a [a] -> Deps a) -> Map a [a] -> Deps a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Map a [a]
forall k a. k -> a -> Map k a
M.singleton a
x [a]
ys

-- | Inverse dependencies, i.e. make map where keys are dependencies and elements are targets depends on it
inverse :: Ord a => Deps a -> Deps a
inverse :: Deps a -> Deps a
inverse = [Deps a] -> Deps a
forall a. Monoid a => [a] -> a
mconcat ([Deps a] -> Deps a) -> (Deps a -> [Deps a]) -> Deps a -> Deps a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Deps a) -> [(a, a)] -> [Deps a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a -> Deps a) -> (a, a) -> Deps a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Deps a
forall a. a -> a -> Deps a
dep) ([(a, a)] -> [Deps a])
-> (Deps a -> [(a, a)]) -> Deps a -> [Deps a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [a]) -> [(a, a)]) -> [(a, [a])] -> [(a, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [a]) -> [(a, a)]
forall a. (a, [a]) -> [(a, a)]
inverse' ([(a, [a])] -> [(a, a)])
-> (Deps a -> [(a, [a])]) -> Deps a -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a [a] -> [(a, [a])]
forall k a. Map k a -> [(k, a)]
M.toList (Map a [a] -> [(a, [a])])
-> (Deps a -> Map a [a]) -> Deps a -> [(a, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps a -> Map a [a]
forall a. Deps a -> Map a [a]
_depsMap where
	inverse' :: (a, [a]) -> [(a, a)]
	inverse' :: (a, [a]) -> [(a, a)]
inverse' (a
m, [a]
ds) = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ds (a -> [a]
forall a. a -> [a]
repeat a
m)

newtype DepsError a =
	CyclicDeps [a]
	-- ^ Dependency cycle, list is cycle, where last item depends on first
		deriving (DepsError a -> DepsError a -> Bool
(DepsError a -> DepsError a -> Bool)
-> (DepsError a -> DepsError a -> Bool) -> Eq (DepsError a)
forall a. Eq a => DepsError a -> DepsError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepsError a -> DepsError a -> Bool
$c/= :: forall a. Eq a => DepsError a -> DepsError a -> Bool
== :: DepsError a -> DepsError a -> Bool
$c== :: forall a. Eq a => DepsError a -> DepsError a -> Bool
Eq, Eq (DepsError a)
Eq (DepsError a)
-> (DepsError a -> DepsError a -> Ordering)
-> (DepsError a -> DepsError a -> Bool)
-> (DepsError a -> DepsError a -> Bool)
-> (DepsError a -> DepsError a -> Bool)
-> (DepsError a -> DepsError a -> Bool)
-> (DepsError a -> DepsError a -> DepsError a)
-> (DepsError a -> DepsError a -> DepsError a)
-> Ord (DepsError a)
DepsError a -> DepsError a -> Bool
DepsError a -> DepsError a -> Ordering
DepsError a -> DepsError a -> DepsError a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (DepsError a)
forall a. Ord a => DepsError a -> DepsError a -> Bool
forall a. Ord a => DepsError a -> DepsError a -> Ordering
forall a. Ord a => DepsError a -> DepsError a -> DepsError a
min :: DepsError a -> DepsError a -> DepsError a
$cmin :: forall a. Ord a => DepsError a -> DepsError a -> DepsError a
max :: DepsError a -> DepsError a -> DepsError a
$cmax :: forall a. Ord a => DepsError a -> DepsError a -> DepsError a
>= :: DepsError a -> DepsError a -> Bool
$c>= :: forall a. Ord a => DepsError a -> DepsError a -> Bool
> :: DepsError a -> DepsError a -> Bool
$c> :: forall a. Ord a => DepsError a -> DepsError a -> Bool
<= :: DepsError a -> DepsError a -> Bool
$c<= :: forall a. Ord a => DepsError a -> DepsError a -> Bool
< :: DepsError a -> DepsError a -> Bool
$c< :: forall a. Ord a => DepsError a -> DepsError a -> Bool
compare :: DepsError a -> DepsError a -> Ordering
$ccompare :: forall a. Ord a => DepsError a -> DepsError a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (DepsError a)
Ord, ReadPrec [DepsError a]
ReadPrec (DepsError a)
Int -> ReadS (DepsError a)
ReadS [DepsError a]
(Int -> ReadS (DepsError a))
-> ReadS [DepsError a]
-> ReadPrec (DepsError a)
-> ReadPrec [DepsError a]
-> Read (DepsError a)
forall a. Read a => ReadPrec [DepsError a]
forall a. Read a => ReadPrec (DepsError a)
forall a. Read a => Int -> ReadS (DepsError a)
forall a. Read a => ReadS [DepsError a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DepsError a]
$creadListPrec :: forall a. Read a => ReadPrec [DepsError a]
readPrec :: ReadPrec (DepsError a)
$creadPrec :: forall a. Read a => ReadPrec (DepsError a)
readList :: ReadS [DepsError a]
$creadList :: forall a. Read a => ReadS [DepsError a]
readsPrec :: Int -> ReadS (DepsError a)
$creadsPrec :: forall a. Read a => Int -> ReadS (DepsError a)
Read)

instance Show a => Show (DepsError a) where
	show :: DepsError a -> String
show (CyclicDeps [a]
c) = String
"dependencies forms a cycle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [a -> String
forall a. Show a => a -> String
show a
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " | a
d <- [a]
c] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."

-- | Flatten dependencies so that there will be no indirect dependencies
flatten :: Ord a => Deps a -> Either (DepsError a) (Deps a)
flatten :: Deps a -> Either (DepsError a) (Deps a)
flatten s :: Deps a
s@(Deps Map a [a]
ds) = (([a], Deps a) -> Deps a)
-> Either (DepsError a) ([a], Deps a)
-> Either (DepsError a) (Deps a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a], Deps a) -> Deps a
forall a b. (a, b) -> b
snd (Either (DepsError a) ([a], Deps a)
 -> Either (DepsError a) (Deps a))
-> (Map a [a] -> Either (DepsError a) ([a], Deps a))
-> Map a [a]
-> Either (DepsError a) (Deps a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT ([a], Deps a) (Either (DepsError a)) ()
 -> ([a], Deps a) -> Either (DepsError a) ([a], Deps a))
-> ([a], Deps a)
-> StateT ([a], Deps a) (Either (DepsError a)) ()
-> Either (DepsError a) ([a], Deps a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ([a], Deps a) (Either (DepsError a)) ()
-> ([a], Deps a) -> Either (DepsError a) ([a], Deps a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ([a], Deps a)
forall a. Monoid a => a
mempty (StateT ([a], Deps a) (Either (DepsError a)) ()
 -> Either (DepsError a) ([a], Deps a))
-> (Map a [a] -> StateT ([a], Deps a) (Either (DepsError a)) ())
-> Map a [a]
-> Either (DepsError a) ([a], Deps a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StateT ([a], Deps a) (Either (DepsError a)) [a])
-> [a] -> StateT ([a], Deps a) (Either (DepsError a)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall a.
Ord a =>
Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
flatten' Deps a
s) ([a] -> StateT ([a], Deps a) (Either (DepsError a)) ())
-> (Map a [a] -> [a])
-> Map a [a]
-> StateT ([a], Deps a) (Either (DepsError a)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a [a] -> [a]
forall k a. Map k a -> [k]
M.keys (Map a [a] -> Either (DepsError a) (Deps a))
-> Map a [a] -> Either (DepsError a) (Deps a)
forall a b. (a -> b) -> a -> b
$ Map a [a]
ds where
	flatten' :: Ord a => Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
	flatten' :: Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
flatten' Deps a
s' a
n = do
		[a]
path <- (([a], Deps a) -> [a])
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting [a] ([a], Deps a) [a] -> ([a], Deps a) -> [a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [a] ([a], Deps a) [a]
forall s t a b. Field1 s t a b => Lens s t a b
_1)
		Bool
-> StateT ([a], Deps a) (Either (DepsError a)) ()
-> StateT ([a], Deps a) (Either (DepsError a)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting (First a) [a] a -> [a] -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (([a] -> Const (First a) [a]) -> [a] -> Const (First a) [a]
forall a. Reversing a => Iso' a a
reversed (([a] -> Const (First a) [a]) -> [a] -> Const (First a) [a])
-> Getting (First a) [a] a -> Getting (First a) [a] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First a) [a] a
forall s t a b. Each s t a b => Traversal s t a b
each) [a]
path Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
n) (StateT ([a], Deps a) (Either (DepsError a)) ()
 -> StateT ([a], Deps a) (Either (DepsError a)) ())
-> StateT ([a], Deps a) (Either (DepsError a)) ()
-> StateT ([a], Deps a) (Either (DepsError a)) ()
forall a b. (a -> b) -> a -> b
$ DepsError a -> StateT ([a], Deps a) (Either (DepsError a)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([a] -> DepsError a
forall a. [a] -> DepsError a
CyclicDeps ([a] -> DepsError a) -> [a] -> DepsError a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
path)
		Maybe [a]
d <- (([a], Deps a) -> Maybe [a])
-> StateT ([a], Deps a) (Either (DepsError a)) (Maybe [a])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (First [a]) ([a], Deps a) [a] -> ([a], Deps a) -> Maybe [a]
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First [a]) ([a], Deps a) [a]
 -> ([a], Deps a) -> Maybe [a])
-> Getting (First [a]) ([a], Deps a) [a]
-> ([a], Deps a)
-> Maybe [a]
forall a b. (a -> b) -> a -> b
$ (Deps a -> Const (First [a]) (Deps a))
-> ([a], Deps a) -> Const (First [a]) ([a], Deps a)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Deps a -> Const (First [a]) (Deps a))
 -> ([a], Deps a) -> Const (First [a]) ([a], Deps a))
-> (([a] -> Const (First [a]) [a])
    -> Deps a -> Const (First [a]) (Deps a))
-> Getting (First [a]) ([a], Deps a) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Deps a) -> Traversal' (Deps a) (IxValue (Deps a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix a
Index (Deps a)
n)
		case Maybe [a]
d of
			Just [a]
d' -> [a] -> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
d'
			Maybe [a]
Nothing -> a
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall a (m :: * -> *) b.
MonadState ([a], Deps a) m =>
a -> m b -> m b
pushPath a
n (StateT ([a], Deps a) (Either (DepsError a)) [a]
 -> StateT ([a], Deps a) (Either (DepsError a)) [a])
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall a b. (a -> b) -> a -> b
$ do
				[a]
d'' <- ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
deps'])) ([[a]] -> [a])
-> StateT ([a], Deps a) (Either (DepsError a)) [[a]]
-> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> StateT ([a], Deps a) (Either (DepsError a)) [a])
-> [a] -> StateT ([a], Deps a) (Either (DepsError a)) [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall a.
Ord a =>
Deps a -> a -> StateT ([a], Deps a) (Either (DepsError a)) [a]
flatten' Deps a
s') [a]
deps'
				(([a], Deps a) -> ([a], Deps a))
-> StateT ([a], Deps a) (Either (DepsError a)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter ([a], Deps a) ([a], Deps a) (Deps a) (Deps a)
-> (Deps a -> Deps a) -> ([a], Deps a) -> ([a], Deps a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ([a], Deps a) ([a], Deps a) (Deps a) (Deps a)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Deps a -> Deps a) -> ([a], Deps a) -> ([a], Deps a))
-> (Deps a -> Deps a) -> ([a], Deps a) -> ([a], Deps a)
forall a b. (a -> b) -> a -> b
$ Deps a -> Deps a -> Deps a
forall a. Monoid a => a -> a -> a
mappend (a -> [a] -> Deps a
forall a. a -> [a] -> Deps a
deps a
n [a]
d''))
				[a] -> StateT ([a], Deps a) (Either (DepsError a)) [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
d''
				where
					deps' :: [a]
deps' = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (([a] -> Const (First [a]) [a])
 -> Deps a -> Const (First [a]) (Deps a))
-> Deps a -> Maybe [a]
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Deps a) -> Traversal' (Deps a) (IxValue (Deps a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix a
Index (Deps a)
n) Deps a
s'
	pushPath :: MonadState ([a], Deps a) m => a -> m b -> m b
	pushPath :: a -> m b -> m b
pushPath a
p m b
act = do
		(([a], Deps a) -> ([a], Deps a)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter ([a], Deps a) ([a], Deps a) [a] [a]
-> ([a] -> [a]) -> ([a], Deps a) -> ([a], Deps a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ([a], Deps a) ([a], Deps a) [a] [a]
forall s t a b. Field1 s t a b => Lens s t a b
_1 (a
pa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
		b
r <- m b
act
		(([a], Deps a) -> ([a], Deps a)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter ([a], Deps a) ([a], Deps a) [a] [a]
-> ([a] -> [a]) -> ([a], Deps a) -> ([a], Deps a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ([a], Deps a) ([a], Deps a) [a] [a]
forall s t a b. Field1 s t a b => Lens s t a b
_1 [a] -> [a]
forall a. [a] -> [a]
tail)
		b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

selfDepend :: Deps a -> Deps a
selfDepend :: Deps a -> Deps a
selfDepend = Map a [a] -> Deps a
forall a. Map a [a] -> Deps a
Deps (Map a [a] -> Deps a) -> (Deps a -> Map a [a]) -> Deps a -> Deps a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]) -> Map a [a] -> Map a [a]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\a
s [a]
d -> [a]
d [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
s]) (Map a [a] -> Map a [a])
-> (Deps a -> Map a [a]) -> Deps a -> Map a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps a -> Map a [a]
forall a. Deps a -> Map a [a]
_depsMap

-- | Linearize dependencies so that all items can be processed in this order,
-- i.e. for each item all its dependencies goes before
linearize :: Ord a => Deps a -> Either (DepsError a) [a]
linearize :: Deps a -> Either (DepsError a) [a]
linearize = (Deps a -> [a])
-> Either (DepsError a) (Deps a) -> Either (DepsError a) [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> (Deps a -> [a]) -> Deps a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> (Deps a -> [[a]]) -> Deps a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [[a]]) (Deps a) [a] -> Deps a -> [[a]]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Map a [a] -> Const (Endo [[a]]) (Map a [a]))
-> Deps a -> Const (Endo [[a]]) (Deps a)
forall a b. Lens (Deps a) (Deps b) (Map a [a]) (Map b [b])
depsMap ((Map a [a] -> Const (Endo [[a]]) (Map a [a]))
 -> Deps a -> Const (Endo [[a]]) (Deps a))
-> (([a] -> Const (Endo [[a]]) [a])
    -> Map a [a] -> Const (Endo [[a]]) (Map a [a]))
-> Getting (Endo [[a]]) (Deps a) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Const (Endo [[a]]) [a])
-> Map a [a] -> Const (Endo [[a]]) (Map a [a])
forall s t a b. Each s t a b => Traversal s t a b
each) (Deps a -> [[a]]) -> (Deps a -> Deps a) -> Deps a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps a -> Deps a
forall a. Deps a -> Deps a
selfDepend) (Either (DepsError a) (Deps a) -> Either (DepsError a) [a])
-> (Deps a -> Either (DepsError a) (Deps a))
-> Deps a
-> Either (DepsError a) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps a -> Either (DepsError a) (Deps a)
forall a. Ord a => Deps a -> Either (DepsError a) (Deps a)
flatten

nubConcat :: Ord a => [a] -> [a] -> [a]
nubConcat :: [a] -> [a] -> [a]
nubConcat [a]
xs [a]
ys = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys