argon 0.3.2.0 → 0.4.0.0

raw patch · 22 files changed

+302/−115 lines, 22 filesdep +Cabaldep +lens-simpledep +pipesdep ~pathwalkPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, lens-simple, pipes, pipes-group

Dependency ranges changed: pathwalk

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−7
• USAGE.txt +7/−4
• app/Main.hs +21/−40
• argon.cabal +26/−5
• src/Argon.hs +10/−2
• src/Argon/Cabal.hs +46/−0
• src/Argon/Formatters.hs +26/−32
• src/Argon/Parser.hs +19/−11
• src/Argon/Results.hs +39/−7
• src/Argon/SYB/Utils.hs +2/−0
• src/Argon/Types.hs +21/−3
• src/Argon/Walker.hs +35/−0
• stack-7.8.yaml +2/−0
• test/ArgonSpec.hs +26/−4
• test/data/arrows.hs +9/−0
• test/tree/a.hs +0/−0
• test/tree/a.txt +0/−0
• test/tree/b.txt +0/−0
• test/tree/sub/b.hs +0/−0
• test/tree/sub/c.hs +0/−0
• test/tree/sub2/a.hs +0/−0
• test/tree/sub2/e.hs +0/−0

@@ -2,10 +2,16 @@  This package uses [Semantic Versioning][1]. +## v0.4.0.0++- Add streaming capabilities (haskell-pipes) for lower memory usage: #18.+- Add `--cabal-macros` and `--include-dir` options: #17.+- Add `--cabal-file` to read default extensions: #19.+ ## v0.3.2.0 -- Fix error in CPP processing: #14-- Include updated `everythingStaged` code (by @alanz): #20+- Fix error in CPP processing: #14.+- Include updated `everythingStaged` code (by @alanz): #20.  ## v0.3.1.2 @@ -13,20 +19,20 @@  ## v0.3.1.1 -- Add test data to sdist: fpco/stackage#932+- Add test data to sdist: fpco/stackage#932.  ## v0.3.1.0 -- Add compatibility with GHC 7.8: #6+- Add compatibility with GHC 7.8: #6.  ## v0.3.0.0 -- Major: replace Haskell-Src-Exts with GHC API: #5-- Add basic tests: #7+- Major: replace Haskell-Src-Exts with GHC API: #5.+- Add basic tests: #7.  ## v0.2.0.0 -- Add `USAGE.txt` to tarball: #2+- Add `USAGE.txt` to tarball: #2.  ## v0.1.0.0 

@@ -2,7 +2,10 @@     argon [options] <paths>...  Options:-    -h --help       show this help-    -m --min=<n>    the minimum complexity to show in results-    --no-color      results are not colored-    -j --json       results are serialized to JSON+    -h --help                   show this help+    -m --min=<n>                the minimum complexity to show in results+    --cabal-file=<path>         path to Cabal main file+    --cabal-macros=<path>       Cabal header file with versions macros+    -I --include-dir=<path>     additional directory with header files+    --no-color                  results are not colored+    -j --json                   results are serialized to JSON

@@ -2,18 +2,9 @@ {-# LANGUAGE QuasiQuotes #-} module Main where -import Data.List (foldl1', isSuffixOf)-import Data.Sequence (Seq)-import qualified Data.Sequence as S-import Data.Foldable (toList)-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (mappend)-import Control.Applicative ((<$>))-#endif+import Pipes+import qualified Pipes.Prelude as P import System.Environment (getArgs)-import System.FilePath ((</>))-import System.Directory-import System.Directory.PathWalk import System.Console.Docopt  import Argon@@ -28,38 +19,28 @@ getOpt :: Arguments -> String -> String -> String getOpt args def opt = getArgWithDefault args def $ longOption opt -haskellFiles :: Seq FilePath -> Seq FilePath-haskellFiles = S.filter (".hs" `isSuffixOf`)--findSourceFiles :: FilePath -> IO (Seq FilePath)-findSourceFiles path =-    pathWalkAccumulate path $ \dir _ files ->-        return $ fmap (dir </>) $ haskellFiles $ S.fromList files--descend :: FilePath -> IO (Seq FilePath)-descend path = do-    isFile <- doesFileExist path-    if isFile then return $ haskellFiles $ S.singleton path-              else findSourceFiles path--allFiles :: [FilePath] -> IO (Seq FilePath)-allFiles paths = foldl1' mappend <$> mapM descend paths--readConfig :: Arguments -> Config-readConfig args =-    Config {-      minCC      = read $ getOpt args "1" "min"-    , outputMode = if args `isPresent` longOption "json"-                      then JSON-                      else if args `isPresent` longOption "no-color"-                              then BareText-                              else Colored+readConfig :: Arguments -> IO Config+readConfig args = do+    xFlags <- maybe (return []) parseExts $ getArg args $ longOption "cabal-file"+    return Config {+      minCC       = read $ getOpt args "1" "min"+    , exts        = xFlags+    , headers     = args `getAllArgs` longOption "cabal-macros"+    , includeDirs = args `getAllArgs` longOption "include-dir"+    , outputMode  = if args `isPresent` longOption "json"+                       then JSON+                       else if args `isPresent` longOption "no-color"+                               then BareText+                               else Colored     }  main :: IO () main = do     args <- parseArgsOrExit patterns =<< getArgs     ins  <- allFiles $ args `getAllArgs` argument "paths"-    res  <- mapM analyze $ toList ins-    let conf = readConfig args-    putStr $ export conf $ map (filterResults conf) res+    conf <- readConfig args+    let source = each ins+              >-> P.mapM (analyze conf)+              >-> P.map (filterResults conf)+              >-> P.filter filterNulls+    runEffect $ exportStream conf source

@@ -1,5 +1,5 @@ name:                argon-version:             0.3.2.0+version:             0.4.0.0 synopsis:            Measure your code's complexity homepage:            http://github.com/rubik/argon bug-reports:         http://github.com/rubik/argon/issues@@ -25,6 +25,10 @@     CHANGELOG.md     USAGE.txt     test/data/*.hs+    test/tree/*.hs+    test/tree/*.txt+    test/tree/sub/*.hs+    test/tree/sub2/*.hs tested-with: GHC >= 7.8 && < 8  library@@ -37,15 +41,25 @@                        Argon.Types                        Argon.Preprocess                        Argon.Loc+                       Argon.Cabal                        Argon.SYB.Utils+                       Argon.Walker   build-depends:       base             >=4.7    && <5                      , ansi-terminal    >=0.6                      , aeson            >=0.8                      , bytestring       >=0.10+                     , pipes            >=4.1+                     , pipes-group      >=1.0+                     , lens-simple      >=0.1                      , ghc              >=7.8    && <8                      , ghc-paths        >=0.1                      , ghc-syb-utils    >=0.2                      , syb              >=0.4+                     , Cabal            >=1.18+                     , containers       >=0.5+                     , pathwalk         >=0.3+                     , filepath         >=1.3+                     , directory        >=1.2   default-language:    Haskell2010   ghc-options:         -Wall   if impl(ghc < 7.8)@@ -57,10 +71,7 @@   ghc-options:         -Wall   build-depends:       base             >=4.7    && <5                      , docopt           >=0.7-                     , pathwalk         >=0.3-                     , filepath         >=1.3-                     , directory        >=1.2-                     , containers       >=0.5+                     , pipes            >=4.1                      , argon            -any   if impl(ghc < 7.10)     build-depends:     pathwalk         >=0.3.1.2@@ -76,13 +87,21 @@                      , ansi-terminal    >=0.6                      , aeson            >=0.8                      , bytestring       >=0.10+                     , pipes            >=4.1+                     , pipes-group      >=1.0+                     , lens-simple      >=0.1                      , ghc              >=7.8    && <8                      , ghc-paths        >=0.1                      , ghc-syb-utils    >=0.2                      , syb              >=0.4+                     , Cabal            >=1.18+                     , containers       >=0.5                      , hspec            >=2.1                      , QuickCheck       -any                      , filepath         >=1.3+                     , docopt           >=0.7+                     , pathwalk         >=0.3+                     , directory        >=1.2   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   if impl(ghc < 7.8)     buildable: False@@ -96,7 +115,9 @@                        Argon.Types                        Argon.Preprocess                        Argon.Loc+                       Argon.Cabal                        Argon.SYB.Utils+                       Argon.Walker  test-suite style   type:                exitcode-stdio-1.0

@@ -14,18 +14,26 @@     , ComplexityBlock(CC)     , OutputMode(..)     , Config(..)+    , defaultConfig     , Loc     , LModule+    -- * Gathering source files+    , allFiles     -- * Parsing     , analyze     , parseModule+    , parseExts+    , flagsMap     -- * Manipulating results     , order     , filterResults-    , export+    , filterNulls+    , exportStream     ) where  import Argon.Parser (LModule, analyze, parseModule)-import Argon.Results (order, export, filterResults)+import Argon.Results (order, filterResults, filterNulls, exportStream)+import Argon.Cabal (flagsMap, parseExts) import Argon.Types import Argon.Loc+import Argon.Walker (allFiles)

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP #-}+module Argon.Cabal (flagsMap, parseExts)+    where++import Data.Maybe (mapMaybe)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#else+import Control.Arrow ((&&&))+#endif++import qualified DynFlags as GHC+import qualified Language.Haskell.Extension            as Dist+import qualified Distribution.Verbosity                as Dist+import qualified Distribution.PackageDescription       as Dist+import qualified Distribution.PackageDescription.Parse as Dist+++-- | A 'Map' from extensions names to extensions flags+flagsMap :: Map String GHC.ExtensionFlag+flagsMap = M.fromList $ map specToPair GHC.xFlags++-- | Parse the given Cabal file generate a list of GHC extension flags. The+--   extension names are read from the default-extensions field in the library+--   section.+parseExts :: FilePath -> IO [GHC.ExtensionFlag]+parseExts path = extract <$> Dist.readPackageDescription Dist.silent path+    where extract pkg = maybe [] extFromBI $+            (Dist.libBuildInfo . Dist.condTreeData) <$> Dist.condLibrary pkg++extFromBI :: Dist.BuildInfo -> [GHC.ExtensionFlag]+extFromBI = mapMaybe (get . toString) . Dist.defaultExtensions+    where get = flip M.lookup flagsMap+          toString (Dist.UnknownExtension ext) = ext+          toString (Dist.EnableExtension  ext) = show ext+          toString (Dist.DisableExtension ext) = show ext++#if __GLASGOW_HASKELL__ < 710+specToPair :: (String, GHC.ExtensionFlag, a) -> (String, GHC.ExtensionFlag)+specToPair (a, b, _) = (a, b)+#else+specToPair :: GHC.FlagSpec GHC.ExtensionFlag -> (String, GHC.ExtensionFlag)+specToPair = GHC.flagSpecName &&& GHC.flagSpecFlag+#endif

@@ -1,33 +1,30 @@-module Argon.Formatters (bareTextFormatter, coloredTextFormatter-                        , jsonFormatter)+{-# LANGUAGE LambdaCase #-}+module Argon.Formatters (bareTextFormatter, coloredTextFormatter)     where -import Data.Aeson (encode)-import qualified Data.ByteString.Lazy.Char8 as B-import Data.List (intercalate) import Text.Printf (printf) import System.Console.ANSI +import Pipes+import qualified Pipes.Prelude as P+ import Argon.Types import Argon.Loc  -bareTextFormatter :: [(FilePath, AnalysisResult)] -> String-bareTextFormatter = formatSingle $ formatResult-    (printf "%s\n\t%s")-    (\e -> "error:" ++ e)-    (\(CC (l, func, cc)) -> printf "%s %s - %d" (locToString l) func cc)--coloredTextFormatter :: [(FilePath, AnalysisResult)] -> String-coloredTextFormatter = formatSingle $ formatResult-    (\name rest -> printf "%s%s%s\n\t%s%s" open name reset rest reset)-    (\e -> printf "%serror%s: %s%s" (fore Red) reset e reset)-    (\(CC (l, func, cc)) -> printf "%s %s - %s%s" (locToString l)-                                                  (coloredFunc func l)-                                                  (coloredRank cc) reset)+bareTextFormatter :: Pipe (FilePath, AnalysisResult) String IO ()+bareTextFormatter = formatResult+    id+    ("\terror:" ++)+    (\(CC (l, func, cc)) -> printf "\t%s %s - %d" (locToString l) func cc) -jsonFormatter :: [(FilePath, AnalysisResult)] -> String-jsonFormatter = B.unpack . encode+coloredTextFormatter :: Pipe (FilePath, AnalysisResult) String IO ()+coloredTextFormatter = formatResult+    (\name -> open ++ name ++ reset)+    (printf "\t%serror%s: %s" (fore Red) reset)+    (\(CC (l, func, cc)) -> printf "\t%s %s - %s%s" (locToString l)+                                                    (coloredFunc func l)+                                                    (coloredRank cc) reset)  open :: String open = setSGRCode [SetConsoleIntensity BoldIntensity]@@ -49,17 +46,14 @@             | c <= 10   = (Yellow, "B")             | otherwise = (Red,    "C") -formatSingle :: ((FilePath, AnalysisResult) -> String)-             -> [(FilePath, AnalysisResult)]-             -> String-formatSingle f = unlines . filter (not . null) . map f--formatResult :: (String -> String -> String)  -- ^ The block formatter+formatResult :: (String -> String)            -- ^ The header formatter              -> (String -> String)            -- ^ The error formatter              -> (ComplexityBlock -> String)   -- ^ The single line formatter-             -> (FilePath, AnalysisResult) -> String-formatResult resultBlock errorF _ (name, Left err) =-    resultBlock name $ errorF err-formatResult _ _ _ (_,    Right []) = ""-formatResult resultBlock _ singleF (name, Right rs) =-    resultBlock name $ intercalate "\n\t" $ map singleF rs+             -> Pipe (FilePath, AnalysisResult) String IO ()+formatResult header errorF singleF = for cat $ \case+    (path, Left err) -> do+        yield $ header path+        yield $ errorF err+    (path, Right rs) -> do+        yield $ header path+        each rs >-> P.map singleF

@@ -2,6 +2,7 @@ module Argon.Parser (LModule, analyze, parseModule)     where +import Data.List (foldl') import Control.Monad (void) import qualified Control.Exception as E @@ -29,11 +30,12 @@  -- | Parse the code in the given filename and compute cyclomatic complexity for --   every function binding.-analyze :: FilePath  -- ^ The filename corresponding to the source code+analyze :: Config    -- ^ Configuration options+        -> FilePath  -- ^ The filename corresponding to the source code         -> IO (FilePath, AnalysisResult)-analyze file = do+analyze conf file = do     parseResult <- (do-        result <- parseModule file+        result <- parseModule conf file         E.evaluate result) `E.catch` handleExc     let analysis = case parseResult of                       Left err  -> Left err@@ -44,16 +46,21 @@ handleExc = return . Left . show  -- | Parse a module with the default instructions for the C pre-processor-parseModule :: FilePath -> IO (Either String LModule)-parseModule = parseModuleWithCpp defaultCppOptions+--   Only the includes directory is taken from the config+parseModule :: Config -> FilePath -> IO (Either String LModule)+parseModule conf = parseModuleWithCpp conf $+    defaultCppOptions { cppInclude = includeDirs conf+                      , cppFile    = headers conf+                      }  -- | Parse a module with specific instructions for the C pre-processor.-parseModuleWithCpp :: CppOptions+parseModuleWithCpp :: Config+                   -> CppOptions                    -> FilePath                    -> IO (Either String LModule)-parseModuleWithCpp cppOptions file =+parseModuleWithCpp conf cppOptions file =     GHC.runGhc (Just libdir) $ do-      dflags <- initDynFlags file+      dflags <- initDynFlags conf file       let useCpp = GHC.xopt GHC.Opt_Cpp dflags       (fileContents, dflags1) <-         if useCpp@@ -76,12 +83,13 @@           buffer     = GHC.stringToStringBuffer str           parseState = GHC.mkPState flags buffer location -initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags-initDynFlags file = do+initDynFlags :: GHC.GhcMonad m => Config -> FilePath -> m GHC.DynFlags+initDynFlags conf file = do     dflags0 <- GHC.getSessionDynFlags     src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file     (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts-    let dflags2 = dflags1 { GHC.log_action = customLogAction }+    let cabalized = foldl' GHC.xopt_set dflags1 $ exts conf+    let dflags2 = cabalized { GHC.log_action = customLogAction }     void $ GHC.setSessionDynFlags dflags2     return dflags2 

@@ -1,8 +1,22 @@-module Argon.Results (order, filterResults, export)+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Argon.Results (order, filterResults, filterNulls, exportStream)     where  import Data.Ord (comparing) import Data.List (sortBy)+import Data.String (IsString)+import qualified Data.ByteString.Lazy as B+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<*), (*>))+#endif++import Data.Aeson (encode)+import Pipes+import Pipes.Group+import qualified Pipes.Prelude as P+import Lens.Simple ((^.))+ import Argon.Formatters import Argon.Types @@ -20,6 +34,14 @@ order :: [ComplexityBlock] -> [ComplexityBlock] order = sortOn (\(CC ((l, _), f, cc)) -> (-cc, l, f)) +-- | A result is discarded if it correspond to a successful analysis and there+--   are no blocks to show+filterNulls :: (FilePath, AnalysisResult) -> Bool+filterNulls (_, r) = case r of+                       Left  _  -> True+                       Right [] -> False+                       _        -> True+ -- | Filter the results of the analysis, with respect to the given --   'Config'. filterResults :: Config@@ -31,9 +53,19 @@  -- | Export analysis' results. How to export the data is defined by the --   'Config' parameter.-export :: Config -> [(FilePath, AnalysisResult)] -> String-export opts rs =-    case outputMode opts of-        BareText -> bareTextFormatter rs-        Colored  -> coloredTextFormatter rs-        JSON     -> jsonFormatter rs+exportStream :: Config+             -> Producer (FilePath, AnalysisResult) IO ()+             -> Effect IO ()+exportStream conf source =+    case outputMode conf of+      BareText -> source >-> bareTextFormatter >-> P.stdoutLn+      Colored  -> source >-> coloredTextFormatter >-> P.stdoutLn+      JSON     -> jsonStream (source >-> P.map encode) >-> P.mapM_ B.putStr++jsonStream :: IsString a+           => Producer a IO ()+           -> Producer a IO ()+jsonStream source = yield "[" *> intersperse' "," source <* yield "]\n"++intersperse' :: Monad m => a -> Producer a m r -> Producer a m r+intersperse' a producer = intercalates (yield a) (producer ^. chunksOf 1)

@@ -28,6 +28,7 @@       `extQ` postTcType       `extQ` nameList       `extQ` coercion+      `extQ` cmdTable #endif       `extQ` fixity `extQ` nameSet) x = z   | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)@@ -36,5 +37,6 @@         postTcType = const (stage < TypeChecker)               :: PostTcType -> Bool         nameList   = const (stage < TypeChecker)               :: [Name] -> Bool         coercion   = const (stage < TypeChecker)               :: Coercion -> Bool+        cmdTable   = const (stage < TypeChecker)               :: CmdSyntaxTable RdrName -> Bool #endif         fixity     = const (stage < Renamer)                   :: GHC.Fixity -> Bool

@@ -7,7 +7,7 @@ #endif  module Argon.Types (ComplexityBlock(CC), AnalysisResult, Config(..)-                   , OutputMode(..), GhcParseError(..))+                   , OutputMode(..), GhcParseError(..), defaultConfig)     where  import Data.List (intercalate)@@ -15,6 +15,7 @@ import Data.Typeable import Control.Exception (Exception) +import qualified DynFlags as GHC import Argon.Loc  @@ -36,9 +37,15 @@ -- | Type holding all the options passed from the command line. data Config = Config {     -- | Minimum complexity a block has to have to be shown in results.-    minCC :: Int+    minCC       :: Int+    -- | Path to the main Cabal file+  , exts        :: [GHC.ExtensionFlag]+    -- | Header files to be automatically included before preprocessing+  , headers     :: [FilePath]+    -- | Additional include directories for the C preprocessor+  , includeDirs :: [FilePath]     -- | Describe how the results should be exported.-  , outputMode :: OutputMode+  , outputMode  :: OutputMode   }  -- | Type describing how the results should be exported.@@ -46,6 +53,17 @@                 | Colored  -- ^ Text-only output, with colors.                 | JSON     -- ^ Data is serialized to JSON.                 deriving (Show, Eq)++-- | Default configuration options.+--+--   __Warning__: These are not Argon's default options.+defaultConfig :: Config+defaultConfig = Config { minCC       = 1+                       , exts        = []+                       , headers     = []+                       , includeDirs = []+                       , outputMode  = JSON+                       }  instance Exception GhcParseError 

@@ -0,0 +1,35 @@+{-# LANGUAGE CPP #-}+module Argon.Walker (allFiles)+    where++import Data.Sequence (Seq)+import qualified Data.Sequence as S+import Data.List (foldl1', isSuffixOf)+#if __GLASGOW_HASKELL__ < 710+import Data.Monoid (mappend)+import Control.Applicative ((<$>))+#endif+import System.FilePath ((</>))+import System.Directory+import System.Directory.PathWalk+++-- | Starting from a list of paths, generate a sequence of paths corresponding+--   to Haskell files. The fileystem is traversed in a manner similar to+--   reversed DFS.+allFiles :: [FilePath] -> IO (Seq FilePath)+allFiles paths = foldl1' mappend <$> mapM descend paths++descend :: FilePath -> IO (Seq FilePath)+descend path = do+    isFile <- doesFileExist path+    if isFile then return $ haskellFiles $ S.singleton path+              else findSourceFiles path++haskellFiles :: Seq FilePath -> Seq FilePath+haskellFiles = S.filter (".hs" `isSuffixOf`)++findSourceFiles :: FilePath -> IO (Seq FilePath)+findSourceFiles path =+    pathWalkAccumulate path $ \dir _ files ->+        return $ fmap (dir </>) $ haskellFiles $ S.fromList files

@@ -7,4 +7,6 @@ - pathwalk-0.3.1.2 - syb-0.4.4 - ghc-7.8.4+- lens-simple-0.1.0.8+- lens-family-1.2.0 resolver: lts-2.22

@@ -4,8 +4,10 @@ module ArgonSpec (spec)     where +import Data.Foldable (toList) import Data.List (sort, isPrefixOf) import Data.Either (isLeft, lefts)+import qualified Data.Sequence as S #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), (<*>)) #endif@@ -15,6 +17,7 @@ import System.IO.Unsafe (unsafePerformIO) import qualified SrcLoc     as GHC import qualified FastString as GHC+ import Argon import Argon.Loc @@ -41,9 +44,12 @@ path f = "test" </> "data" </> f  shouldAnalyze :: String -> AnalysisResult -> Expectation-shouldAnalyze f r = analyze p `shouldReturn` (p, r)+shouldAnalyze f r = analyze defaultConfig p `shouldReturn` (p, r)     where p = path f +shouldReturnS :: IO (S.Seq FilePath) -> [FilePath] -> Expectation+shouldReturnS action res = action >>= ((`shouldBe` (sort res)) . sort . toList)+ spec :: Spec spec = do     describe "Argon.Loc" $ do@@ -77,7 +83,7 @@                 property $ \xs -> order xs == order (order xs)         describe "filterResults" $ do             it "discards results with too low complexity" $-                filterResults (Config { minCC = 3, outputMode = BareText })+                filterResults (Config 3 [] [] [] BareText )                               ("p", Right [ CC (ones, "f", 3)                                           , CC (lo 2, "g", 2)                                           , CC (lo 4, "h", 10)@@ -86,7 +92,7 @@                               ("p", Right [ CC (lo 4, "h", 10)                                           , CC (ones, "f", 3)])             it "does nothing on Left" $-                property $ \m o p err -> filterResults (Config m o)+                property $ \m o p err -> filterResults (Config m [] [] [] o)                                                        (p, Left err) ==                                                        (p, Left err)     describe "analyze" $ do@@ -134,13 +140,29 @@                 "typefamilies.hs" `shouldAnalyze` Right []             it "works with ForeignImport" $                 "foreignimports.hs" `shouldAnalyze` Right []+            it "works with Arrows" $+                "arrows.hs" `shouldAnalyze` Right [CC (lo 7, "getAnchor", 1)]         describe "errors" $ do             it "catches syntax errors" $                 "syntaxerror.hs" `shouldAnalyze`                     Left ("2:1 parse error (possibly incorrect indentation" ++                           " or mismatched brackets)")             it "catches CPP parsing errors" $-                unsafePerformIO (analyze (path "cpp-error.hs")) `shouldSatisfy`+                unsafePerformIO (analyze defaultConfig (path "cpp-error.hs"))+                `shouldSatisfy`                 \(_, res) ->                     isLeft res && ("2:0  error: unterminated #else"                                    `isPrefixOf` head (lefts [res]))+    describe "Argon.Walker" $+        describe "allFiles" $ do+            it "traverses the filesystem with reversed DFS" $+                allFiles ["test" </> "tree"] `shouldReturnS`+                    [ "test" </> "tree" </> "a.hs"+                    , "test" </> "tree" </> "sub2" </> "e.hs"+                    , "test" </> "tree" </> "sub2" </> "a.hs"+                    , "test" </> "tree" </> "sub"  </> "c.hs"+                    , "test" </> "tree" </> "sub"  </> "b.hs"+                    ]+            it "includes starting files in the result" $+                allFiles ["test" </> "tree" </> "a.hs"] `shouldReturnS`+                    ["test" </> "tree" </> "a.hs"]

@@ -0,0 +1,9 @@+{-# LANGUAGE Arrows #-}++-- | First argument: basis for a new "pretty" anchor if none exists yet+-- Second argument: a key ("ugly" anchor)+-- Returns: saved "pretty" anchor or created new one+getAnchor :: OdtReaderSafe (AnchorPrefix, Anchor) Anchor+getAnchor = proc (baseIdent, uglyAnchor) -> do+    state <- getExtraState -< ()+    returnA -< prettyAnchor