Merge branch 'main' into add-tests

CHANGELOG.md

@@ -1,5 +1,9 @@
 # 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
 
 * Expose SJW as a library and make sjw executable use it

SJW.cabal

@@ -3,7 +3,7 @@ cabal-version:       >=1.10
 -- further documentation, see http://haskell.org/cabal/users-guide/
 
 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.
 -- description:
 homepage:            https://git.marvid.fr/Tissevert/SJW

src/SJW/Dependencies.hs

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