lsfrom-1.0: Main.hs

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'