Fix bug in loop reporting causing in some cases the display of an inaccurate loop instead of the one actually detected

This commit is contained in:
Tissevert 2020-05-21 18:03:12 +02:00
parent ad8b878fd7
commit 70bcc60ed5
3 changed files with 11 additions and 8 deletions

View File

@ -1,5 +1,9 @@
# Revision history for SJW # Revision history for SJW
## 0.1.2.1 -- 2020-05-21
* Fix bug in loop reporting causing in some cases the display of an inaccurate loop instead of the one actually detected
## 0.1.2.0 -- 2020-01-10 ## 0.1.2.0 -- 2020-01-10
* Expose SJW as a library and make sjw executable use it * Expose SJW as a library and make sjw executable use it

View File

@ -3,7 +3,7 @@ cabal-version: >=1.10
-- further documentation, see http://haskell.org/cabal/users-guide/ -- further documentation, see http://haskell.org/cabal/users-guide/
name: SJW name: SJW
version: 0.1.2.0 version: 0.1.2.1
synopsis: The Simple Javascript Wrench is a very simple tool to pack several JS «modules» into a single script. synopsis: The Simple Javascript Wrench is a very simple tool to pack several JS «modules» into a single script.
-- description: -- description:
homepage: https://git.marvid.fr/Tissevert/SJW homepage: https://git.marvid.fr/Tissevert/SJW

View File

@ -7,7 +7,7 @@ module SJW.Dependencies (
) where ) where
import SJW.Source (Path) import SJW.Source (Path)
import Control.Monad.Except (MonadError(..), runExcept) import Control.Monad.Except (MonadError(..))
import Control.Monad.RWS (MonadState, MonadWriter, evalRWST, gets, modify, tell) import Control.Monad.RWS (MonadState, MonadWriter, evalRWST, gets, modify, tell)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Map (Map, (!)) import Data.Map (Map, (!))
@ -19,10 +19,7 @@ type Dependencies = Map Path (Set Path)
type Failable = MonadError String type Failable = MonadError String
solve :: Failable m => Dependencies -> m [Path] solve :: Failable m => Dependencies -> m [Path]
solve dependencies = solve dependencies = snd <$> evalRWST dfs () initState
case runExcept $ evalRWST dfs () initState of
Left loop -> throwError $ printLoop loop
Right (_, sorted) -> return sorted
where where
initState = State {graph = (,) New <$> dependencies, ariadne = []} initState = State {graph = (,) New <$> dependencies, ariadne = []}
@ -32,7 +29,7 @@ data State = State {
, ariadne :: [Path] , ariadne :: [Path]
} }
type DFSComputation m = (MonadWriter [Path] m, MonadState State m, MonadError [Path] m) type DFSComputation m = (MonadWriter [Path] m, MonadState State m, MonadError String m)
dfs :: DFSComputation m => m () dfs :: DFSComputation m => m ()
dfs = do dfs = do
@ -53,7 +50,9 @@ modifyState ((path, flag), f) = modify $ \state -> state {
visit :: DFSComputation m => (Path, (Flag, Set Path)) -> m () visit :: DFSComputation m => (Path, (Flag, Set Path)) -> m ()
visit (_, (Permanent, _)) = return () visit (_, (Permanent, _)) = return ()
visit (_, (Temporary, _)) = throwError =<< gets (reverse . ariadne) visit (loopStart, (Temporary, _)) = do
loop <- gets (dropWhile (/= loopStart) . reverse . ariadne)
throwError $ printLoop loop
visit (path, (New, set)) = do visit (path, (New, set)) = do
modifyState ((path, Temporary), (path:)) modifyState ((path, Temporary), (path:))
mapM_ (\depPath -> (,) depPath <$> gets ((!depPath) . graph) >>= visit) set mapM_ (\depPath -> (,) depPath <$> gets ((!depPath) . graph) >>= visit) set