packages feed

stan 0.2.0.0 → 0.2.1.0

raw patch · 5 files changed

+126/−42 lines, 5 filesdep +directory-ospath-streamingdep ~claydep ~containersdep ~hedgehog

Dependencies added: directory-ospath-streaming

Dependency ranges changed: clay, containers, hedgehog, optparse-applicative, slist

Files

CHANGELOG.md view
@@ -3,6 +3,17 @@ `stan` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.2.1.0++* Fix high memory usage in finding Cabal files++  See:+  https://github.com/kowainik/stan/pull/586#issuecomment-2906713949++  Thanks to @0rphee++* Support `clay-0.16`+ ## 0.2.0.0  * Add the following inspections:
src/Stan/Cabal.hs view
@@ -6,6 +6,11 @@ Functions to work with cabal files and cabal extension maps. -} +{-# LANGUAGE CPP #-}+#ifdef MIN_VERSION_directory_ospath_streaming+{-# LANGUAGE QuasiQuotes #-}+#endif+ module Stan.Cabal     ( createCabalExtensionsMap     , usedCabalFiles@@ -19,14 +24,22 @@ import Control.Exception (catch) import Extensions (CabalException, ExtensionsError (..), ExtensionsResult, ParsedExtensions (..),                    mergeAnyExtensions, parseCabalFileExtensions)-import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, listDirectory,-                         makeRelativeToCurrentDirectory)-import System.FilePath (takeExtension, (</>))-import System.IO.Unsafe (unsafeInterleaveIO)+import System.Directory (doesFileExist, makeRelativeToCurrentDirectory)  import Stan.Hie.Compat (HieFile (..))  import qualified Data.Map.Strict as Map+#ifndef MIN_VERSION_directory_ospath_streaming+import System.IO.Unsafe (unsafeInterleaveIO)+import qualified System.Directory as FilePath+import qualified System.FilePath as FilePath+#else+import qualified System.OsPath as OsPath+import qualified System.Directory.OsPath as OsPath+import qualified System.Directory.OsPath.Streaming as OPS+import qualified System.Directory.OsPath.Types as OPS+import qualified Data.Set as S+#endif   {- | Gets the list of @.cabal@ file paths that were used in the project.@@ -84,46 +97,92 @@ subdirectories. It returns maximum 1 @.cabal@ file from each directory. -} findCabalFiles :: IO [FilePath]-findCabalFiles = do-    dir <- getCurrentDirectory-    curDirCabal <- findCabalFileDir dir-    dirs <- getSubdirsRecursive dir-    subDirsCabals <- mapM findCabalFileDir dirs-    pure $ catMaybes $ curDirCabal : subDirsCabals+findCabalFiles =+#ifndef MIN_VERSION_directory_ospath_streaming+    findCabalFilesFilePath+#else+    findCabalFilesStreaming+#endif --- | Find a @.cabal@ file in the given directory.--- TODO: better error handling in stan.-findCabalFileDir :: FilePath -> IO (Maybe FilePath)-findCabalFileDir dir = do-    dirContent <- listDirectory dir-    let cabalFiles = filter isCabal dirContent-    pure $ case cabalFiles of-        []          -> Nothing -- throwError $ NoCabalFile dirPath-        [cabalFile] -> Just $ dir </> cabalFile-        x:_xs       -> Just x -- throwError $ MultipleCabalFiles (x :| xs)+#ifndef MIN_VERSION_directory_ospath_streaming+findCabalFilesFilePath :: IO [FilePath]+findCabalFilesFilePath = do+    dir <- FilePath.getCurrentDirectory+    curDirCabal <- findCabalFileFilePath dir+    dirs <- getSubdirsRecursiveFilePath dir+    subDirsCabals <- mapM findCabalFileFilePath dirs+    pure $ catMaybes $ curDirCabal : subDirsCabals   where-    isCabal :: FilePath -> Bool-    isCabal p = takeExtension p == ".cabal"+    -- | Find a @.cabal@ file in the given directory.+    -- TODO: better error handling in stan.+    findCabalFileFilePath :: FilePath -> IO (Maybe FilePath)+    findCabalFileFilePath dir = do+        dirContent <- FilePath.listDirectory dir+        let cabalFiles = filter isCabal dirContent+        pure $ case cabalFiles of+            []            -> Nothing+            cabalFile : _ -> Just $ dir FilePath.</> cabalFile+      where+        isCabal :: FilePath -> Bool+        isCabal p = FilePath.takeExtension p == ".cabal" -getSubdirsRecursive :: FilePath -> IO [FilePath]-getSubdirsRecursive fp = do-    all' <- filter nonGenDir <$> listDirectory fp-    dirs <- filterM doesDirectoryExist (mkRel <$> all')-    case dirs of-        [] -> pure []-        ds -> do-            -- unsafeInterleaveIO is required here for performance reasons-            next <- unsafeInterleaveIO $ foldMapA getSubdirsRecursive ds-            pure $ dirs ++ next+    getSubdirsRecursiveFilePath :: FilePath -> IO [FilePath]+    getSubdirsRecursiveFilePath fp = do+        all' <- filter nonGenDir <$> FilePath.listDirectory fp+        dirs <- filterM FilePath.doesDirectoryExist (mkRel <$> all')+        case dirs of+            [] -> pure []+            ds -> do+                -- unsafeInterleaveIO is required here for performance reasons+                next <- unsafeInterleaveIO $ foldMapA getSubdirsRecursiveFilePath ds+                pure $ dirs ++ next+      where+        nonGenDir :: FilePath -> Bool+        nonGenDir d =+               d /= "dist"+            && d /= "dist-newstyle"+            && d /= ".stack-work"+            && d /= ".git"++        mkRel :: FilePath -> FilePath+        mkRel = (fp FilePath.</>)++#else+-- Fix for https://github.com/haskell/haskell-language-server/issues/4515+findCabalFilesStreaming :: IO [FilePath]+findCabalFilesStreaming = do+    setRef <- newIORef S.empty -- stores the directories where we already found 1 cabal file+    root <- OsPath.getCurrentDirectory+    traverse OsPath.decodeFS =<<+        OPS.listContentsRecFold+           Nothing -- Depth limit+            (\_ _ (OPS.Relative _dirRelPath) (OPS.Basename dirBasename)  _symlinkType _consDirToList traverseThisSubdir rest ->+                 if visitCurrSubdirPred dirBasename -- if this condition is satisfied+                 then traverseThisSubdir rest -- True -> then this subdir will be traversed+                 else rest -- False -> else, this subdir will not be traversed+                ) -- how to fold this directory and its children, given its path+            (\_ _ (OPS.Relative path) (OPS.Basename fileBasename) _ft -> do+                  let parentDir = OsPath.takeDirectory path+                  set <- readIORef setRef+                  if not (S.member parentDir set) && collectPred fileBasename -- if this condition is satisfied+                  then do+                        writeIORef setRef $  S.insert parentDir set -- we add the parentDir of this file, to prevent adding more than 1 .cabal file+                        pure (Just path) -- True -> then this path will be added to the results (because @path@ is already relative, we no longer need @mkRel@)+                  else pure Nothing -- False -> else, this path wont be added+                )+            (Identity root) -- (f a), list of roots to search in   where-    nonGenDir :: FilePath -> Bool-    nonGenDir d =-           d /= "dist"-        && d /= "dist-newstyle"-        && d /= ".stack-work"+    visitCurrSubdirPred :: OsPath.OsPath -> Bool+    visitCurrSubdirPred d =+           d /= [OsPath.osp|dist|]+        && d /= [OsPath.osp|dist-newstyle|]+        && d /= [OsPath.osp|.stack-work|]+        && d /= [OsPath.osp|.git|] -    mkRel :: FilePath -> FilePath-    mkRel = (fp </>)+    collectPred :: OsPath.OsPath -> Bool+    collectPred p =+        OsPath.takeExtension p == [OsPath.osp|.cabal|]+#endif  mergeParsedExtensions     :: Either ExtensionsError ParsedExtensions
src/Stan/Report/Css.hs view
@@ -15,7 +15,7 @@  import Prelude hiding (div, rem, (&), (**)) -import Clay hiding (brown, cols, grid, border, borderRight, borderTop, borderLeft, borderBottom)+import Clay hiding ((%), brown, cols, grid, border, borderRight, borderTop, borderLeft, borderBottom) import qualified Clay  import qualified Clay.Media as M
stack.yaml view
@@ -12,3 +12,8 @@ - trial-0.0.0.0@sha256:eaefa22bf10b04a9149ef0231cfd5e42ff47534221d4cf4ad3d7653090c54d23,4410 - trial-optparse-applicative-0.0.0.0@sha256:3ca376f1361a3b623a52b8db8e178cdca5f2e6e3954d217b874a9af823ab6c06,2540 - trial-tomland-0.0.0.0@sha256:5dc32bd4003dc84565170e316576eb7a0c1cea3e8b8b3815d5f509b4a40577fd,2541+- directory-ospath-streaming-0.2.2@sha256:8931b9ce6e63bf6202dc0c992ae3e6f2ad8e7f4b6eb69994ac6d512c6c9c0f77,3410++flags:+  directory-ospath-streaming:+    os-string: false
stan.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                stan-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Haskell STatic ANalyser description:     Stan is a Haskell __ST__atic __AN__alysis CLI tool.@@ -31,6 +31,12 @@   type:                git   location:            https://github.com/kowainik/stan.git +flag directory-ospath-streaming+  default: True+  manual: False+  description:+    Whether to use directory-ospath-streaming. Should be false with 9.6 > ghc.+ common common-options   build-depends:       base >= 4.13 && < 4.22 && (< 4.16.3.0 || >= 4.17)                        -- ^^ .hie files don't contain enough type@@ -143,7 +149,7 @@                      , base64 >= 0.4.1 && < 1.1                      , blaze-html ^>= 0.9.1                      , bytestring >= 0.10 && < 0.13-                     , clay >= 0.14 && < 0.16+                     , clay >= 0.14 && < 0.17                      , colourista >= 0.1 && < 0.3                      , containers >= 0.5 && < 0.8                      , cryptohash-sha1 ^>= 0.11@@ -163,6 +169,9 @@                      , trial ^>= 0.0.0.0                      , trial-optparse-applicative ^>= 0.0.0.0                      , trial-tomland ^>= 0.0.0.0+  if flag(directory-ospath-streaming)+    build-depends:+                     directory-ospath-streaming ^>= 0.2  executable stan   import:              common-options