--- SJW -- Clean Javascript modules for front-end development
--- Copyright © 2022 Tissevert <tissevert+devel@marvid.fr>
---
--- This file is part of SJW.
---
--- SJW is free software: you can redistribute it and/or modify it under the
--- terms of the GNU General Public License as published by the Free Software
--- Foundation, either version 3 of the License, or (at your option) any later
--- version.
---
--- SJW is distributed in the hope that it will be useful, but WITHOUT ANY
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
--- details.
---
--- You should have received a copy of the GNU General Public License along
--- with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module SJW.Dependencies (
      Dependencies
    , Failable
    , solve
  ) where

import SJW.Source (Path)
import Control.Monad.Except (MonadError(..))
import Control.Monad.RWS (MonadState, MonadWriter, evalRWST, gets, modify, tell)
import Data.List (intercalate)
import Data.Map (Map, (!))
import qualified Data.Map as Map (adjust, toList)
import Data.Set (Set)
import Text.Printf (printf)

type Dependencies = Map Path (Set Path)
type Failable = MonadError String

solve :: Failable m => Dependencies -> m [Path]
solve dependencies = snd <$> evalRWST dfs () initState
  where
    initState = State {graph = (,) New <$> dependencies, ariadne = []}

data Flag = New | Temporary | Permanent deriving (Eq, Ord)
data State = State {
      graph :: Map Path (Flag, Set Path)
    , ariadne :: [Path]
  }

type DFSComputation m = (MonadWriter [Path] m, MonadState State m, MonadError String m)

dfs :: DFSComputation m => m ()
dfs = do
  maybeNewNode <- gets (popNew . Map.toList . graph)
  case maybeNewNode of
    Nothing -> return ()
    Just newNode -> visit newNode >> dfs
  where
    popNew [] = Nothing
    popNew ((k, v@(New, _)):_) = Just (k, v)
    popNew (_:others) = popNew others

modifyState :: MonadState State m => ((Path, Flag), [Path] -> [Path]) -> m ()
modifyState ((path, flag), f) = modify $ \state -> state {
      graph = Map.adjust (\(_, set) -> (flag, set)) path $ graph state
    , ariadne = f $ ariadne state
  }

visit :: DFSComputation m => (Path, (Flag, Set Path)) -> m ()
visit (_, (Permanent, _)) = return ()
visit (loopStart, (Temporary, _)) = do
  loop <- gets (dropWhile (/= loopStart) . reverse . ariadne)
  throwError $ printLoop loop
visit (path, (New, set)) = do
  modifyState ((path, Temporary), (path:))
  mapM_ (\depPath -> (,) depPath <$> gets ((!depPath) . graph) >>= visit) set
  modifyState ((path, Permanent), (drop 1))
  tell [path]

printLoop :: [Path] -> String
printLoop [] = "Weird dependencies cycle found"
printLoop (path:paths) = beginning ++ description paths
  where
    beginning = "Dependencies cycle found: "
    description [] = printf "module %s requires itself." (show path)
    description _ =
      printf "%s requires %s which itself requires %s." first others first
    first = show path
    others = intercalate " which requires " $ show <$> paths