lsfrom 1.0 → 2.0
raw patch · 7 files changed
+291/−146 lines, 7 filesdep +extradep +processdep +setlocaledep −safedep ~directorydep ~simple-cmddep ~simple-cmd-args
Dependencies added: extra, process, setlocale
Dependencies removed: safe
Dependency ranges changed: directory, simple-cmd, simple-cmd-args
Files
- ChangeLog.md +6/−1
- Main.hs +0/−83
- README.md +63/−25
- lsfrom.cabal +15/−13
- src/Collate.hs +48/−0
- src/Main.hs +122/−0
- test/tests.hs +37/−24
ChangeLog.md view
@@ -1,12 +1,17 @@ # Release history for lsfrom +## 2.0 (2025-02-10)+- major rewrite introducing --from file option+- --after, --until, --before are also file options+- uses locale collation with C FFI+- add --dirs and --files file-type filters+ ## 1.0 (2024-01-07) - add --after: start with the next file after the specified one - add --until: include files only up to the specified file - add --before: changes the behaviour of --until - add --strict: error if the specified files do not exist - the short option for --all is now -A-- ## 0.1.1.1 (2022-04-24) - add missing test files
− Main.hs
@@ -1,83 +0,0 @@-module Main (main) where--import Data.List (dropWhileEnd)-import SimpleCmd-import SimpleCmdArgs-import Safe (tailSafe)-import System.FilePath--import Paths_lsfrom (version)--main :: IO ()-main =- simpleCmdArgs (Just version) "List directories files starting from file"- "lsfrom lists the files in a directory that follow from the given file" $- lsfrom- <$> switchWith 's' "strict" "fail if specified file(s) do not exist"- <*> switchWith 'A' "all" "include hidden (dot) files"- <*> switchWith 'a' "after" "files after STARTFILE [default: from STARTFILE]"- <*> optional (removeTrailing <$> strOptionWith 'u' "until" "LASTFILE" "files until FILE")- <*> switchWith 'b' "before" "files before LASTFILE (only affects --until)"- <*> (removeTrailing <$> strArg "STARTFILE")- where- removeTrailing "" = ""- removeTrailing "/" = "/"- removeTrailing f =- if last f == '/'- then removeTrailing $ init f- else f--lsfrom :: Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> FilePath -> IO ()-lsfrom strict hidden after muntil before file =- case reverse (splitDirectories file) of- [] -> error' "empty filename!"- ("":_) -> error' "empty filename!"- (entry@(e:_):revdir) -> do- let dir = joinPath $ reverse revdir- lsout <- cmd "ls" $- ["-A" | hidden || e == '.'] ++ [dir | not (null dir)]- let lsEntries = lines lsout- entryExists = entry `elem` lsEntries- muntilExists =- case muntil of- Nothing -> Nothing- Just until' ->- Just (until', until' `elem` lsEntries)- listingWith <-- lines <$>- if strict- then return lsout- else if entryExists- then case muntilExists of- Just (until',False) ->- sortLs $ prepend until' lsout- _ -> return lsout- else case muntilExists of- Just (until',False) ->- sortLs $- if entry == until'- then prepend entry lsout- else prepend entry $ prepend until' lsout- _ -> sortLs $ prepend entry lsout- let result =- takeUntil muntilExists $- (if after || not entryExists then tailSafe else id) $- dropWhile (entry /=) listingWith- mapM_ (putStrLn . (renderDir dir </>)) result- where- renderDir dir = if dir == "./" then "" else dir-- sortLs :: String -> IO String- sortLs = cmdStdIn "sort" []-- prepend :: String -> String -> String- prepend miss ls = miss ++ '\n' : ls-- takeUntil :: Maybe (String,Bool) -> [String] -> [String]- takeUntil Nothing es = es- takeUntil (Just _) [] = []- takeUntil (Just (until',exists)) es =- case dropWhileEnd (until' /=) es of- [] -> []- es' ->- (if before || not exists then init else id) es'
README.md view
@@ -1,46 +1,81 @@ # lsfrom -`lsfrom` lists the files and dirs in a directory starting from-the given filename or the first file after that-if the file does not exist, using the current locale collation order.+`lsfrom` lists the files and/or dirs in a directory starting from+the given filename or the next one after that,+using the current locale collation order. +## Tutorial++Consider a directory with a few files: ```shellsession $ ls-A a B C-$ echo $(lsfrom a)-a B C-$ lsfrom a/-a+A b B C+```+(`lsfrom` is typically more useful in larger directories,+but to keep things simple let's use a small example here.)++Let's list the files after `b`:+```shellsession+$ lsfrom --after b/ B C-$ lsfrom /sy-/sys+```++Equivalently the files from `B`:+```shellsession+$ echo $(lsfrom --from B)+B C+```++We can also list until:+```shellsession+$ lsfrom --until B+A+b+B+```+Note the file (collation) order will depend on the locale in general:+```shellsession+$ LC_COLLATE=C echo $(lsfrom -f B)+B C b+```++`--from`/`--after` can be combined with `--until`/`--before`.+Without any of these options, the output should be similar to `ls -A`,+but only 1 file per line.++The file of the path given does not need to exist (unless using --strict mode):+```shellsession+$ lsfrom -a /t /tmp /usr /var ``` -It can be useful for continuing a script on the entries of a directory-after a failure, etc:+It is also possible to filter the listing with `--dirs` or `--files`. +A common use-case is continuing a program or script on+the entries of a directory after a failure, etc: ```shellsession-$ myscript.sh $(lsfrom next)+$ myscript.sh $(lsfrom -f next) ```--or only running a command on a subrange of files in a directory.+or only running a command on a subrange of files or dirs in a directory. ## Usage `$ lsfrom --version`+ ```-1.0+2.0 ``` `$ lsfrom -h`+ ``` List directories files starting from file -Usage: lsfrom [--version] [-s|--strict] [-A|--all] [-a|--after]- [-u|--until LASTFILE] [-b|--before] STARTFILE+Usage: lsfrom [--version] [-s|--strict] [-A|--all] [--dirs | --files]+ [(-f|--from STARTFILE) | (-a|--after STARTFILE)]+ [(-u|--until LASTFILE) | (-b|--before LASTFILE)] lsfrom lists the files in a directory that follow from the given file @@ -49,17 +84,20 @@ --version Show version -s,--strict fail if specified file(s) do not exist -A,--all include hidden (dot) files- -a,--after files after STARTFILE [default: from STARTFILE]- -u,--until LASTFILE files until FILE- -b,--before files before LASTFILE (only affects --until)+ --dirs Only list directories+ --files Only list files+ -f,--from STARTFILE files from STARTFILE+ -a,--after STARTFILE files after STARTFILE+ -u,--until LASTFILE files until LASTFILE+ -b,--before LASTFILE files before LASTFILE ``` ## Requirements+Tested on Linux (may also work on MacOS):+specifically it uses libc collation (`wcscoll()`) for file ordering. -It uses `ls` to list files with locale sorting-and requires the `-A` option to exclude `.` and `..` (ie coreutils).-It also uses `sort` when injecting missing marker files.-It has been tested on Linux.+It also uses `ls` to list files sorted in the locale collation+with the `-A` option to exclude `./` and `../` (ie coreutils). ## Installation
lsfrom.cabal view
@@ -1,19 +1,17 @@ cabal-version: 2.0 name: lsfrom-version: 1.0+version: 2.0 synopsis: List directory files starting from a specific name description: `lsfrom` lists the entries of a directory starting from- a particular file and then the files after it- with respect to locale collation ordering.-- This can be useful for example for continuing a command or script- in a directory after a failure.+ a particular file in locale collation order, which+ can be useful for continuing a shell command or script+ after a failure on an entry. license: BSD3 license-file: LICENSE author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@redhat.com>-copyright: 2018,2021-2024 Jens Petersen+copyright: 2018,2021-2025 Jens Petersen category: Utility homepage: https://github.com/juhp/lsfrom bug-reports: https://github.com/juhp/lsfrom/issues@@ -29,14 +27,18 @@ location: https://github.com/juhp/lsfrom.git executable lsfrom+ hs-source-dirs: src main-is: Main.hs- other-modules: Paths_lsfrom+ other-modules: Collate+ Paths_lsfrom autogen-modules: Paths_lsfrom build-depends: base < 5,+ directory,+ extra, filepath,- safe,- simple-cmd >= 0.1.4,- simple-cmd-args >= 0.1.2+ setlocale,+ simple-cmd >= 0.2.0,+ simple-cmd-args >= 0.1.8 default-language: Haskell2010 ghc-options: -fwarn-missing-signatures -Wall if impl(ghc >= 8.0)@@ -62,7 +64,7 @@ ghc-options: -Wall build-depends: base >= 4 && < 5- , directory >= 1.2.3.0 , filepath- , simple-cmd >= 0.1.1+ , process+ , simple-cmd build-tool-depends: lsfrom:lsfrom
+ src/Collate.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- with help from Gemini 2.0+-- first CString version: https://g.co/gemini/share/5eedf4ddf81e++module Collate (+ before,+ beforeUnsafe,+ ccollate)+where++import Foreign.C.String+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)++-- | Compares two wide strings using the current locale.+--+-- Returns:+-- - A negative integer if the first string is less than the second.+-- - Zero if the two strings are equal.+-- - A positive integer if the first string is greater than the second.+foreign import ccall safe "wcscoll"+ wcscoll :: CWString -> CWString -> CInt++-- | A safe wrapper around 'wcscoll' that takes Haskell String's and+-- handles the conversion to CWString's.+-- Requires that locale (LC_COLLATE) is set correctly.+wcscoll' :: String -> String -> IO CInt+wcscoll' s1 s2 = do+ withCWString s1 $ \cs1 ->+ withCWString s2 $ \cs2 ->+ return $ wcscoll cs1 cs2++-- | Higher level function that returns an 'Ordering'.+ccollate :: String -> String -> IO Ordering+ccollate s1 s2 = do+ result <- wcscoll' s1 s2+ return $ compare result 0++-- | "ABC" `before` "DEF"+before :: String -> String -> IO Bool+before s1 s2 = do+ res <- ccollate s1 s2+ return $ res == LT++-- | unsafe wrapper+beforeUnsafe :: String -> String -> Bool+beforeUnsafe s1 s2 = unsafePerformIO $ before s1 s2
+ src/Main.hs view
@@ -0,0 +1,122 @@+module Main (main) where++import Control.Monad.Extra (filterM, unless, when, whenJust)+import Data.List.Extra (dropWhileEnd, unsnoc)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (isNothing, maybeToList)+import SimpleCmd (cmdLines, error', warning, (+-+))+import SimpleCmdArgs+import System.Directory (doesDirectoryExist, doesFileExist)+import System.FilePath+import System.Locale.SetLocale (setLocale, Category(LC_COLLATE))++import Collate (beforeUnsafe)+import Paths_lsfrom (version)++data IncludeExclude a = Include a | Exclude a++unInclExcl :: IncludeExclude a -> a+unInclExcl (Include x) = x+unInclExcl (Exclude x) = x++type NEString = NE.NonEmpty Char++showFile :: IncludeExclude NEString -> String+showFile = NE.toList . unInclExcl++data Only = OnlyDirs | OnlyFiles++main :: IO ()+main =+ simpleCmdArgs (Just version) "List directories files starting from file"+ "lsfrom lists the files in a directory that follow from the given file" $+ lsfrom+ <$> switchWith 's' "strict" "fail if specified file(s) do not exist"+ <*> switchWith 'A' "all" "include hidden (dot) files"+ <*> optional+ (flagLongWith' OnlyDirs "dirs" "Only list directories" <|>+ flagLongWith' OnlyFiles "files" "Only list files")+ <*> optional+ (Include <$> optNonEmpty 'f' "from" "STARTFILE" "files from STARTFILE" <|>+ Exclude <$> optNonEmpty 'a' "after" "STARTFILE" "files after STARTFILE")+ <*> optional+ (Include <$> optNonEmpty 'u' "until" "LASTFILE" "files until LASTFILE" <|>+ Exclude <$> optNonEmpty 'b' "before" "LASTFILE" "files before LASTFILE")+ where+ optNonEmpty =+ let readNonEmpty = NE.nonEmpty . removeTrailing+ removeTrailing "" = error' "empty filename not allowed"+ removeTrailing f =+ if f == "/"+ then "/"+ else dropWhileEnd (== '/') f+ in optionWith (maybeReader readNonEmpty)++lsfrom :: Bool -> Bool -> Maybe Only -> Maybe (IncludeExclude NEString)+ -> Maybe (IncludeExclude NEString) -> IO ()+lsfrom strict hidden monly mstart mlast = do+ let dirarg = maybe [] (maybeToList . fst . mdirfile) mstart+ showhidden = hidden || fmap (NE.head . unInclExcl) mstart == Just '.'+ listing <- cmdLines "ls" (["-A" | showhidden] ++ dirarg) >>= filterTypes+ when strict $ do+ whenJust mstart $ \start ->+ unless (showFile start `elem` listing) $+ error' $ showFile start +-+ "does not exist"+ whenJust mlast $ \lst ->+ unless (showFile lst `elem` listing) $+ error' $ showFile lst +-+ "does not exist"+ -- set collation for current locale+ mlocale <- setLocale LC_COLLATE $ Just ""+ when (isNothing mlocale) $ warning "setlocale failed"+ let result = takeLast $ dropStart listing -- uses LC_COLLATE+ mapM_ (putStrLn . (renderDir </>)) result+ where+ mdirfile :: IncludeExclude NEString -> (Maybe FilePath, FilePath)+ mdirfile ie =+ case splitFileName $ showFile ie of+ (d,f) ->+ let md = if d == "./" then Nothing else Just d+ in (md,f)++ filterTypes :: [String] -> IO [String]+ filterTypes =+ case monly of+ Nothing -> return+ Just o ->+ case o of+ OnlyDirs -> filterM doesDirectoryExist+ OnlyFiles -> filterM doesFileExist++ dropStart :: [FilePath] -> [FilePath]+ dropStart files =+ case mstart of+ Nothing -> files+ Just start ->+ case mdirfile start of+ (_,file) ->+ case dropWhile (`beforeUnsafe` file) files of+ [] -> []+ sf@(f:fs) ->+ case start of+ Include _ -> sf+ Exclude e -> if f == NE.toList e then fs else sf++ takeLast files =+ case mlast of+ Nothing -> files+ Just ie ->+ case dropWhileEnd (showFile ie `beforeUnsafe`) files of+ [] -> []+ lf ->+ case ie of+ Include _ -> lf+ Exclude e ->+ case unsnoc lf of+ Nothing -> []+ Just (ls,l) ->+ if l == NE.toList e then ls else lf++ renderDir =+ case fst . mdirfile <$> mstart of+ Just (Just dir) -> dir+ _ -> ""
test/tests.hs view
@@ -1,35 +1,48 @@ {-# LANGUAGE CPP #-} -import Control.Monad-import SimpleCmd-import System.Directory+import Control.Monad (unless)+import SimpleCmd (cmdN, error')+import System.IO (hGetContents)+import System.Process (CreateProcess(..), StdStream(CreatePipe),+ proc, withCreateProcess) -type Test = (FilePath, [String], [String])+type Test = (Maybe String, FilePath, [String], [String]) lsfrom :: Test -> IO ()-lsfrom (dir, args, expect) = do- out <- withCurrentDirectory dir $- cmdLines "lsfrom" args- unless (out == expect) $ do- cmdN "lsfrom" args- putStrLn $ "returned> " ++ show out- putStrLn $ "expected> " ++ show expect- error' "failed"+lsfrom (mlocale, dir, args, expect) = do+ let menv = mlocale >>= \l -> Just [("LC_ALL",l)]+ withCreateProcess+ (proc "lsfrom" args)+ { cwd = Just dir, env = menv, std_out = CreatePipe } $+ \ _si mso _se _p ->+ case mso of+ Nothing -> error "no stdout handle found"+ Just so -> do+ out <- hGetContents so+ unless (lines out == expect) $ do+ print mlocale+ cmdN "lsfrom" args+ putStrLn $ "returned> " ++ show out+ putStrLn $ "expected> " ++ show expect+ error' "failed" tests :: [Test] tests =- [ ("test/files", ["B"], ["B","C"])- , ("test/files", ["-a", "B"], ["C"])- , ("test", ["files/C/"], ["files/C"])- , ("test/files", ["Bb"], ["C"])- , ("test/files", ["-u", "B", "A"], ["A", "B"])- , ("test/files", ["-u", "C", "-b", "A"], ["A", "B"])- , ("test/files", ["-u", "C", "-b", "-a", "A"], ["B"])- , ("test/files", ["-u", "A", "-b", "-a", "C"], [])- , ("test/files", ["-u", "B", "-b", "B"], [])- , ("test/files", ["-u", "B", "-a", "B"], [])- , ("test/files", ["-u", "B", "-a", "-b", "B"], [])- , ("test/files", ["-s", "-u", "B", "A"], ["A", "B"])+ [ (Nothing, "test/files", ["-f", "B"], ["B","C"])+ , (Nothing, "test/files", ["-a", "B"], ["C"])+ , (Nothing, "test", ["-f", "files/C/"], ["files/C"])+ , (Nothing, "test/files", ["-f", "Bb"], ["C"])+ , (Nothing, "test/files", ["-u", "B", "-f", "A"], ["A", "B"])+ , (Nothing, "test/files", ["-b", "C", "-f", "A"], ["A", "B"])+ , (Nothing, "test/files", ["-b", "C", "-a", "A"], ["B"])+ , (Nothing, "test/files", ["-b", "A", "-a", "C"], [])+ , (Nothing, "test/files", ["-b", "B", "-f", "B"], [])+ , (Nothing, "test/files", ["-u", "B", "-a", "B"], [])+ , (Nothing, "test/files", ["-b", "B", "-a", "B"], [])+ , (Nothing, "test/files", ["-s", "-u", "B", "-f", "A"], ["A", "B"])+ , (Just "C", "test/cases", [], ["A", "B", "a", "b"])+ , (Just "ja_JP.utf8", "test/cases", [], ["A", "B", "a", "b"])+ , (Just "en_US.UTF-8", "test/cases", [], ["a", "A", "b", "B"]) ] main :: IO ()