| 
 Copyright    : ( c ) 2020 Fugue , Inc. 
 License      : Apache License , version 2.0 
 Maintainer   :  
 Stability    : experimental 
 Portability : POSIX 

 Pure , simple dependency management . 

Copyright   : (c) 2020 Fugue, Inc.
License     : Apache License, version 2.0
Maintainer  : 
Stability   : experimental
Portability : POSIX

Pure, simple dependency management.
-}
{-# LANGUAGE FlexibleContexts      #-}
# LANGUAGE FlexibleInstances      #
# LANGUAGE GADTs                  #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE OverloadedStrings      #
# LANGUAGE RecordWildCards        #
{-# LANGUAGE ScopedTypeVariables   #-}
module Fregot.Interpreter.Dependencies
    ( DependencyError

    , Graph (..)
    , plan
    , evict
    ) where

import           Data.Hashable      (Hashable)
import qualified Data.HashSet       as HS
import qualified Fregot.PrettyPrint as PP

data DependencyError k
    = DependencyCycle [k]
    deriving (Show)

instance PP.Pretty PP.Sem k => PP.Pretty PP.Sem (DependencyError k) where
    pretty (DependencyCycle rev) =
        let trail = reverse $ zipWith ($)
                (id : repeat (PP.<+> "depends on")) (map PP.pretty rev) in
        "Cyclic dependency error:" PP.<$$> PP.ind (PP.vcat trail)

-- | Somewhat abstract graph representation.
data Graph k = Graph
    { graphDone         :: [k]
    , graphIsDone       :: k -> Bool
    , graphDependencies :: k -> [k]
    }

-- | Compute a plan to build the requested nodes.
plan
    :: forall k. (Eq k, Hashable k)
    => Graph k                         -- ^ Dependency graph
    -> HS.HashSet k                    -- ^ Wanted nodes
    -> Either (DependencyError k) [k]  -- ^ Error or plan
plan Graph {..} = go HS.empty []
  where
    go :: HS.HashSet k -> [k] -> HS.HashSet k -> Either (DependencyError k) [k]
    go done acc wanted = case HS.toList wanted of
        [] -> pure (reverse acc)
        w : _ | w `HS.member` done || graphIsDone w ->
            go done acc (w `HS.delete` wanted)
        w : _ -> do
            x <- chase done [] w
            go (x `HS.insert` done) (x : acc) (x `HS.delete` wanted)

    chase :: HS.HashSet k -> [k] -> k -> Either (DependencyError k) k
    chase done trail current =
        -- All dependencies not yet taken care of.
        let next =
                [ n
                | n <- graphDependencies current
                , not (n `HS.member` done)
                , not (graphIsDone n)
                ] in

        -- Look where we should head next.
        case next of
            []                       -> Right current
            (n : _) | n `elem` trail -> Left $ DependencyCycle (n : current : trail)
            n : _                    -> chase done (current : trail) n

-- | If a node is removed from the "done" set, we'll also need to remove all the
-- nodes that depended on it.  This function computes that set in a simple way
-- by just computing the fixpoint.
evict
    :: (Eq k, Hashable k)
    => Graph k          -- ^ Dependency graph
    -> HS.HashSet k     -- ^ Nodes you want to evict
    -> HS.HashSet k     -- ^ All nodes that need to be evicted
evict Graph {..} = go
  where
    go closure =
        let new   = HS.fromList $ filter ood graphDone
            ood n =
                not (n `HS.member` closure) &&
                any (`HS.member` closure) (graphDependencies n) in

        if HS.null new then closure else go (closure `HS.union` new)

# LANGUAGE FlexibleContexts      #
# LANGUAGE ScopedTypeVariables   #
 | Somewhat abstract graph representation.
 | Compute a plan to build the requested nodes.
 ^ Dependency graph
 ^ Wanted nodes
 ^ Error or plan
 All dependencies not yet taken care of.
 Look where we should head next.
 | If a node is removed from the "done" set, we'll also need to remove all the
 nodes that depended on it.  This function computes that set in a simple way
 by just computing the fixpoint.
 ^ Dependency graph
 ^ Nodes you want to evict
 ^ All nodes that need to be evicted
| 
 Copyright    : ( c ) 2020 Fugue , Inc. 
 License      : Apache License , version 2.0 
 Maintainer   :  
 Stability    : experimental 
 Portability : POSIX 

 Pure , simple dependency management . 

Copyright   : (c) 2020 Fugue, Inc.
License     : Apache License, version 2.0
Maintainer  : 
Stability   : experimental
Portability : POSIX

Pure, simple dependency management.
-}
# LANGUAGE FlexibleInstances      #
# LANGUAGE GADTs                  #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE OverloadedStrings      #
# LANGUAGE RecordWildCards        #
module Fregot.Interpreter.Dependencies
    ( DependencyError

    , Graph (..)
    , plan
    , evict
    ) where

import           Data.Hashable      (Hashable)
import qualified Data.HashSet       as HS
import qualified Fregot.PrettyPrint as PP

data DependencyError k
    = DependencyCycle [k]
    deriving (Show)

instance PP.Pretty PP.Sem k => PP.Pretty PP.Sem (DependencyError k) where
    pretty (DependencyCycle rev) =
        let trail = reverse $ zipWith ($)
                (id : repeat (PP.<+> "depends on")) (map PP.pretty rev) in
        "Cyclic dependency error:" PP.<$$> PP.ind (PP.vcat trail)

data Graph k = Graph
    { graphDone         :: [k]
    , graphIsDone       :: k -> Bool
    , graphDependencies :: k -> [k]
    }

plan
    :: forall k. (Eq k, Hashable k)
plan Graph {..} = go HS.empty []
  where
    go :: HS.HashSet k -> [k] -> HS.HashSet k -> Either (DependencyError k) [k]
    go done acc wanted = case HS.toList wanted of
        [] -> pure (reverse acc)
        w : _ | w `HS.member` done || graphIsDone w ->
            go done acc (w `HS.delete` wanted)
        w : _ -> do
            x <- chase done [] w
            go (x `HS.insert` done) (x : acc) (x `HS.delete` wanted)

    chase :: HS.HashSet k -> [k] -> k -> Either (DependencyError k) k
    chase done trail current =
        let next =
                [ n
                | n <- graphDependencies current
                , not (n `HS.member` done)
                , not (graphIsDone n)
                ] in

        case next of
            []                       -> Right current
            (n : _) | n `elem` trail -> Left $ DependencyCycle (n : current : trail)
            n : _                    -> chase done (current : trail) n

evict
    :: (Eq k, Hashable k)
evict Graph {..} = go
  where
    go closure =
        let new   = HS.fromList $ filter ood graphDone
            ood n =
                not (n `HS.member` closure) &&
                any (`HS.member` closure) (graphDependencies n) in

        if HS.null new then closure else go (closure `HS.union` new)
