diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,8 @@ # Changelog -# 0.1 (2019-06-xx) -- Initially created. +# 0.1.1 (2022-10-19) +- add --show-url option +- misc cleanups +# 0.1 (2019-06-23) +- Initially created. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -import BasicPrelude import SimpleCmdArgs +import Control.Monad import qualified Data.ByteString.Char8 as B +import Data.List +import Data.Maybe import qualified Data.Text as T import Network.HTTP.Directory import System.Directory @@ -19,7 +19,12 @@ main = simpleCmdArgs (Just version) "find for http" "Find files from an http \"directory\"" $ - listFiles <$> depthOpt <*> optional filetypeOpt <*> optional nameOpt <*> strArg "URL/DIR" + listFiles + <$> depthOpt + <*> optional filetypeOpt + <*> optional nameOpt + <*> switchWith 'u' "show-urls" "Prefix files with url" + <*> strArg "URL/DIR" where nameOpt :: Parser String nameOpt = strOptionWith 'n' "name" "GLOB" "Limit files to glob matches" @@ -33,11 +38,11 @@ depthOpt :: Parser Int depthOpt = optionalWith auto 'm' "maxdepth" "DEPTH" "Maximum search depth (default 10)" 10 -listFiles :: Int -> Maybe FileType -> Maybe String -> String -> IO () -listFiles maxdepth mfiletype mname dir = +listFiles :: Int -> Maybe FileType -> Maybe String -> Bool -> String -> IO () +listFiles maxdepth mfiletype mname showurl dir = if isHttpUrl dir then do mgr <- httpManager - findHttp mgr maxdepth mfiletype Nothing mname $ makeDir dir + findHttp mgr maxdepth mfiletype Nothing mname showurl $ makeDir dir else findDir maxdepth mfiletype mname dir @@ -53,17 +58,17 @@ isdir <- doesDirectoryExist file if isdir then do when (fileType TypeDir mfiletype && glob f) $ - putStrLn $ T.pack $ addTrailingPathSeparator file + putStrLn $ addTrailingPathSeparator file findDir (maxdepth-1) mfiletype mname file else do symlink <- pathIsSymbolicLink file if symlink then do tgt <- getSymbolicLinkTarget file when (fileType TypeSymlink mfiletype && glob f) $ - putStrLn $ T.pack $ file <> " -> " <> tgt + putStrLn $ file <> " -> " <> tgt else when (fileType TypeFile mfiletype && glob f) $ - putStrLn $ T.pack file + putStrLn file glob = maybe (const True) (match . compile) mname @@ -71,9 +76,10 @@ fileType ftype = maybe True (== ftype) -findHttp :: Manager -> Int -> Maybe FileType -> Maybe Text -> Maybe String -> String -> IO () -findHttp _ n _ _ _ _ | n <= 0 = return () -findHttp mgr maxdepth mfiletype mprefix mname url = do +findHttp :: Manager -> Int -> Maybe FileType -> Maybe FilePath -> Maybe String + -> Bool -> String -> IO () +findHttp _ n _ _ _ _ _ | n <= 0 = return () +findHttp mgr maxdepth mfiletype mprefix mname showurl url = do fs <- sort <$> httpDirectory mgr url mapM_ (display . T.unpack) fs where @@ -86,17 +92,18 @@ if filetype == TypeDir then do let dirname = dropTrailingPathSeparator f when (fileType TypeDir mfiletype && glob dirname) $ - putStrLn $ prefix f + putStrLn $ maybeurl prefix ++ f let dir = addTrailingPathSeparator f - findHttp mgr (maxdepth-1) mfiletype (mprefix <> Just (T.pack dir)) mname $ url dir + findHttp mgr (maxdepth-1) mfiletype (mprefix <> Just dir) mname showurl $ url dir else when (fileType TypeFile mfiletype && glob f) $ - putStrLn $ prefix f + putStrLn $ maybeurl prefix ++ f glob = maybe (const True) (match . compile) mname - prefix = (fromMaybe "" mprefix <>) . T.pack + prefix = fromMaybe "" mprefix + maybeurl = if showurl then (url +/+) else id makeDir :: String -> String makeDir path = if last path == '/' then path else path <> "/" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,50 @@ # findhttp [![Hackage](https://img.shields.io/hackage/v/findhttp.svg)](https://hackage.haskell.org/package/findhttp) -[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) -[![Stackage Lts](http://stackage.org/package/findhttp/badge/lts)](http://stackage.org/lts/package/findhttp) -[![Stackage Nightly](http://stackage.org/package/findhttp/badge/nightly)](http://stackage.org/nightly/package/findhttp) -[![Build status](https://secure.travis-ci.org/juhp/findhttp.svg)](https://travis-ci.org/juhp/findhttp) +[![GPL license](https://img.shields.io/badge/license-GPLv3+-brightgreen.svg)](https://www.gnu.org/licenses/gpl.html) -A simple `find` tool that supports http directories too. +A simple `find` tool that supports http directories as well as local files. + +It can be useful for example if you encountered a http directory file server +with html listing that truncates filenames. + +## Usage + +```shellsession +$ findhttp --version +0.1.1 +$ findhttp --help +find for http + +Usage: findhttp [--version] [-m|--maxdepth DEPTH] + [(-f|--files) | (-d|--dirs) | (-s|--symlinks)] [-n|--name GLOB] + [-u|--show-urls] URL/DIR + Find files from an http "directory" + +Available options: + -h,--help Show this help text + --version Show version + -m,--maxdepth DEPTH Maximum search depth (default 10) + -f,--files List files only + -d,--dirs List directories only + -s,--symlinks List symlinks only (not http) + -n,--name GLOB Limit files to glob matches + -u,--show-urls Prefix files with url + +``` + +## Example + +```shellsession +$ findhttp https://file.example.com/files/ +dir1/ +file1 +file2 +file3 +``` + +## Installation + +Build (from Hackage) with `cabal install findhttp` or `stack install findhttp`. + +Build from source with `cabal install` or `stack install`. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/findhttp.cabal b/findhttp.cabal --- a/findhttp.cabal +++ b/findhttp.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: findhttp -version: 0.1 +version: 0.1.1 synopsis: List http/html files description: Tool for listing files (recursively) in an http directory homepage: https://github.com/juhp/findhttp @@ -26,13 +26,12 @@ autogen-modules: Paths_findhttp build-depends: base < 5, - basic-prelude, bytestring, directory >= 1.3.1.0, filepath, Glob, - http-directory >= 0.1.5, - simple-cmd-args, + http-directory >= 0.1.9, + simple-cmd-args >= 0.1.3, text ghc-options: -Wall