diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -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' diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/lsfrom.cabal b/lsfrom.cabal --- a/lsfrom.cabal +++ b/lsfrom.cabal @@ -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 maintainer: Jens Petersen -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 diff --git a/src/Collate.hs b/src/Collate.hs new file mode 100644 --- /dev/null +++ b/src/Collate.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 + _ -> "" diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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 ()