> module Opts (lsopts, long_output, sortdir, prettyprintdir, colour_output, > one_per_line, screen_width, tabstop, show_blocksize, > filter_backups, escape_characters, quote_names, numeric_ids, > comma_list, show_usage, listdirentries, showbasenames, > addshowbasenames, isrecursive, raw_characters, > get_human_readable, show_version, show_inodes, > classify_filenames, classify_most_filenames, no_show_group, > dereference_symlinks, block_size, full_time, get_time_f) > where > import Type_Data > import Library > import Colour > import Char > import Posix Get the raw data and call parse to parse it > lsopts :: IO [String] -> IO (Success, [Flag], [ColourP], [Pattern], [Mask]) > lsopts ioargs = do args <- ioargs > colours <- get_colours > let (s, flags, patterns, masks) = parse args > return (s, flags, colours, patterns, masks) Parse the list of strings representing the arguments > parse :: [String] -> (Success, [Flag], [Pattern], [Mask]) > parse [] = (Success, [], [], []) > parse (s:ss) = if (take 2 s) == "--" > then longopt ((drop 2 s):ss) > else if (take 1 s) == "-" > then shortopt (drop 1 s) ss > else (sx, fs, ps, s:ms) > where (sx, fs, ps, ms) = parse ss Handle long args of the form --foo > longopt :: [String] -> (Success, [Flag], [Pattern], [Mask]) > longopt ("":ss) = (Success, [], [], ss) > longopt ("all":ss) = addkeepopt ShowAll not_showall (parse ss) > longopt ("almost-all":ss) = addkeepopt ShowMost not_showall (parse ss) > longopt ("escape":ss) = addkeepopt Escape not_format (parse ss) > longopt ("block-size":s:ss) = addkeepopt (BlockSize (stringToInt s)) not_blocksize (parse ss) > longopt ("ignore-backups":ss) = addopt FilterBackups (parse ss) > longopt ("color":c:ss) > = case c of > "always" -> addopt Colour (parse ss) > "auto" -> addopt Colour (parse ss) > "never" -> parse ss > _ -> addopt Colour (parse (c:ss)) > longopt ("color":ss) = addopt Colour (parse ss) > longopt ("directory":ss) = addopt ListDirEntries (parse ss) > longopt ("classify":ss) = addkeepopt Classify not_classify (parse ss) > longopt ("format":f:ss) > = case f of > "single-column" -> addkeepopt OnePerLine not_layout (parse ss) > "across" -> addkeepopt PrintAcross not_layout (parse ss) > "commas" -> addkeepopt CommaList not_layout (parse ss) > "horizontal" -> addkeepopt PrintAcross not_layout (parse ss) > "long" -> addkeepopt Long not_layout (parse ss) > "verbose" -> addkeepopt Long not_layout (parse ss) > "vertical" -> keepopt not_layout (parse ss) > _ -> (Error ("invalid argument `" ++ f ++ "' for `--format'"), [], [], []) > longopt ("full-time":ss) = addopt FullTime (parse ss) > longopt ("no-group":ss) = addopt NoGroups (parse ss) > longopt ("human-readable":ss) = addkeepopt (HumanReadable 1024) not_human_readable (parse ss) > longopt ("si":ss) = addkeepopt (HumanReadable 1000) not_human_readable (parse ss) > longopt ("indicator-style":s:ss) > = case s of > "none" -> keepopt not_classify (parse ss) > "classify" -> addkeepopt Classify not_classify (parse ss) > "file-type" -> addkeepopt ClassifyMost not_classify (parse ss) > _ -> (Error ("invalid argument `" ++ s ++ "' for `--indicator-style'"), [], [], []) > longopt ("inode":ss) = addopt ShowInodes (parse ss) > longopt ("ignore":s:ss) = addpattern s (parse ss) > longopt ("k":ss) = addkeepopt (BlockSize 1024) not_blocksize (parse ss) > longopt ("dereference":ss) = addopt Dereference (parse ss) > longopt ("numeric-uid-gid":ss) = addopt NumericIDs (parse ss) > longopt ("literal":ss) = addkeepopt Raw not_format (parse ss) > longopt ("file-type":ss) = addkeepopt ClassifyMost not_classify (parse ss) > longopt ("hide-control-chars":ss) = addkeepopt QuoteNames not_format (parse ss) > longopt ("show-control-chars":ss) = addkeepopt Raw not_format (parse ss) > longopt ("quote-name":ss) = addkeepopt QuoteNames not_format (parse ss) > longopt ("quoting-style":s:ss) > = case s of > "literal" -> addkeepopt Raw not_format (parse ss) > "locale" -> addkeepopt QuoteNames not_format (parse ss) > "shell" -> addkeepopt QuoteNames not_format (parse ss) > "shell-always" -> addkeepopt QuoteNames not_format (parse ss) > "c" -> addkeepopt QuoteNames not_format (parse ss) > "escape" -> addkeepopt Escape not_format (parse ss) > _ -> (Error ("invalid argument `" ++ s ++ "' for `--quoting-style'"), [], [], []) > longopt ("reverse":ss) = addopt Reverse (parse ss) > longopt ("size":ss) = addkeepopt ShowBlockSize not_blocksize (parse ss) > longopt ("sort":s:ss) = addkeepopt (Sort s) not_sort (parse ss) > longopt ("time":t:ss) > = case t of > "atime" -> addkeepopt ATime not_time (parse ss) > "access" -> addkeepopt ATime not_time (parse ss) > "use" -> addkeepopt ATime not_time (parse ss) > "ctime" -> addkeepopt CTime not_time (parse ss) > "status" -> addkeepopt CTime not_time (parse ss) > _ -> (Error ("invalid argument `" ++ t ++ "' for `--time'"), [], [], []) > longopt ("tabsize":s:ss) = addkeepopt (Tabstop (stringToInt s)) not_tabstop (parse ss) > longopt ("width":s:ss) = addkeepopt (Width (stringToInt s)) not_width (parse ss) > longopt ("help":_) = (ShowUsage, [], [], []) > longopt ("version":_) = (ShowVersion, [], [], []) > longopt (s:ss) = if (or $ map ((==) '=') s) > then longopt (opt:arg:ss) > else (Error ("unrecognized option `--" ++ s ++ "'"), [], [], []) > where (opt, arg) = splitOn '=' s > longopt [] = (Error "Can't happen", [], [], []) Handle short args of the form -f > shortopt :: String -> [String] -> (Success, [Flag], [Pattern], [Mask]) > shortopt "" ss = parse ss > shortopt ('a':s) ss = addkeepopt ShowAll not_showall (shortopt s ss) > shortopt ('A':s) ss = addkeepopt ShowMost not_showall (shortopt s ss) > shortopt ('b':s) ss = addkeepopt Escape not_format (shortopt s ss) > shortopt ('B':s) ss = addopt FilterBackups (shortopt s ss) > shortopt ('c':s) ss = addkeepopt (Sort "time") not_sort $ addkeepopt CTime not_time (shortopt s ss) > shortopt ('C':s) ss = keepopt not_layout (shortopt s ss) > shortopt ('d':s) ss = addopt ListDirEntries (shortopt s ss) > shortopt ('f':s) ss = addkeepopt ShowAll not_showall $ stripopt Long $ stripopt ShowBlockSize $ addkeepopt (Sort "none") not_sort (shortopt s ss) > shortopt ('F':s) ss = addkeepopt Classify not_classify (shortopt s ss) > shortopt ('g':s) ss = shortopt s ss {- ignored -} > shortopt ('G':s) ss = addopt NoGroups (shortopt s ss) > shortopt ('h':s) ss = addkeepopt (HumanReadable 1024) not_human_readable (shortopt s ss) > shortopt ('H':s) ss = addkeepopt (HumanReadable 1000) not_human_readable (shortopt s ss) > shortopt ('i':s) ss = addopt ShowInodes (shortopt s ss) > shortopt "I" (s:ss) = addpattern s (parse ss) > shortopt ('k':s) ss = addkeepopt (BlockSize 1024) not_blocksize (shortopt s ss) > shortopt ('l':s) ss = addkeepopt Long not_layout (shortopt s ss) > shortopt ('L':s) ss = addopt Dereference (shortopt s ss) > shortopt ('m':s) ss = addkeepopt CommaList not_layout (shortopt s ss) > shortopt ('n':s) ss = addopt NumericIDs (shortopt s ss) > shortopt ('N':s) ss = addkeepopt Raw not_format (shortopt s ss) > shortopt ('o':s) ss = addopt NoGroups $ addkeepopt Long not_layout (shortopt s ss) > shortopt ('p':s) ss = addkeepopt ClassifyMost not_classify (shortopt s ss) > shortopt ('q':s) ss = keepopt not_format (shortopt s ss) > shortopt ('Q':s) ss = addkeepopt QuoteNames not_format (shortopt s ss) > shortopt ('r':s) ss = addopt Reverse (shortopt s ss) > shortopt ('R':s) ss = addopt Recursive (shortopt s ss) > shortopt ('s':s) ss = addopt ShowBlockSize (shortopt s ss) > shortopt ('S':s) ss = addkeepopt (Sort "size") not_sort (shortopt s ss) > shortopt ('t':s) ss = addkeepopt (Sort "time") not_sort (shortopt s ss) > shortopt "T" (s:ss) = addkeepopt (Tabstop (stringToInt s)) not_tabstop (parse ss) > shortopt ('u':s) ss = addkeepopt (Sort "time") not_sort $ addkeepopt ATime not_time (shortopt s ss) > shortopt ('U':s) ss = addkeepopt (Sort "none") not_sort (shortopt s ss) > shortopt ('v':s) ss = addkeepopt (Sort "version") not_sort (shortopt s ss) > shortopt "w" (s:ss) = addkeepopt (Width (stringToInt s)) not_width (parse ss) > shortopt ('x':s) ss = addkeepopt PrintAcross not_layout (shortopt s ss) > shortopt ('X':s) ss = addkeepopt (Sort "extension") not_sort (shortopt s ss) > shortopt ('1':s) ss = addkeepopt OnePerLine not_layout (shortopt s ss) > shortopt (s:_) _ = (Error ("invalid option -- " ++ [s]), [], [], []) Add a flag to what we have built up so far removing any previous instances of it for efficiency > addopt :: Flag -> (Success, [Flag], [Pattern], [Mask]) > -> (Success, [Flag], [Pattern], [Mask]) > addopt a (s, fs, ps, ms) = (s, a:(filter ((/=) a) fs), ps, ms) Add an option to what we have built up so far using the filter to remove related options > addkeepopt :: Flag -> (Flag -> Bool) -> (Success, [Flag], [Pattern], [Mask]) > -> (Success, [Flag], [Pattern], [Mask]) > addkeepopt a f (s, fs, ps, ms) = (s, a:(filter f fs), ps, ms) Filter out unwanted flags > keepopt :: (Flag -> Bool) -> (Success, [Flag], [Pattern], [Mask]) > -> (Success, [Flag], [Pattern], [Mask]) > keepopt f (s, fs, ps, ms) = (s, filter f fs, ps, ms) Remove a given flag > stripopt :: Flag -> (Success, [Flag], [Pattern], [Mask]) > -> (Success, [Flag], [Pattern], [Mask]) > stripopt s (su, fs, ps, ms) = (su, filter ((/=) s) fs, ps, ms) Add a pattern to the list so far > addpattern :: Pattern -> (Success, [Flag], [Pattern], [Mask]) > -> (Success, [Flag], [Pattern], [Mask]) > addpattern p (s, fs, ps, ms) = (s, fs, p:ps, ms) Functions for use with keepopt and addkeepopt, use as input to filter > not_time :: Flag -> Bool > not_time ATime = False > not_time CTime = False > not_time _ = True > not_sort :: Flag -> Bool > not_sort (Sort _) = False > not_sort _ = True > not_human_readable :: Flag -> Bool > not_human_readable (HumanReadable _) = False > not_human_readable _ = True > not_blocksize :: Flag -> Bool > not_blocksize (BlockSize _) = False > not_blocksize _ = True > not_tabstop :: Flag -> Bool > not_tabstop (Tabstop _) = False > not_tabstop _ = True > not_width :: Flag -> Bool > not_width (Width _) = False > not_width _ = True > not_format :: Flag -> Bool > not_format = not_these_flags [Raw, Escape, QuoteNames] > not_layout :: Flag -> Bool > not_layout = not_these_flags [Long, PrintAcross, OnePerLine, CommaList] > not_showall :: Flag -> Bool > not_showall = not_these_flags [ShowAll, ShowMost] > not_classify :: Flag -> Bool > not_classify = not_these_flags [Classify, ClassifyMost] > not_these_flags :: [Flag] -> Flag -> Bool > not_these_flags fs f = and $ map ((/=) f) fs Functions to test if a given option has been set > opt_exists :: MyOptions -> Flag -> Bool > opt_exists opts f = or (map ((==) f) opts) > long_output :: MyOptions -> Bool > long_output opts = opt_exists opts Long > sortdir :: MyOptions -> SortOrder > sortdir opts = if opt_exists opts Reverse then Desc else Asc > prettyprintdir :: MyOptions -> PrettyPrintDir > prettyprintdir opts = if opt_exists opts PrintAcross then Across > else Down > colour_output :: MyOptions -> Bool > colour_output opts = opt_exists opts Colour > filter_backups :: MyOptions -> Bool > filter_backups opts = opt_exists opts FilterBackups > escape_characters :: MyOptions -> Bool > escape_characters opts = opt_exists opts Escape > raw_characters :: MyOptions -> Bool > raw_characters opts = opt_exists opts Raw > one_per_line :: MyOptions -> Bool > one_per_line opts = opt_exists opts OnePerLine > quote_names :: MyOptions -> Bool > quote_names opts = opt_exists opts QuoteNames > numeric_ids :: MyOptions -> Bool > numeric_ids opts = opt_exists opts NumericIDs > isrecursive :: MyOptions -> Bool > isrecursive opts = opt_exists opts Recursive > comma_list :: MyOptions -> Bool > comma_list opts = opt_exists opts CommaList > listdirentries :: MyOptions -> Bool > listdirentries opts = opt_exists opts ListDirEntries > show_inodes :: MyOptions -> Bool > show_inodes opts = opt_exists opts ShowInodes > show_blocksize :: MyOptions -> Bool > show_blocksize opts = opt_exists opts ShowBlockSize > classify_filenames :: MyOptions -> Bool > classify_filenames opts = opt_exists opts Classify > classify_most_filenames :: MyOptions -> Bool > classify_most_filenames opts = opt_exists opts ClassifyMost > no_show_group :: MyOptions -> Bool > no_show_group opts = opt_exists opts NoGroups > dereference_symlinks :: MyOptions -> Bool > dereference_symlinks opts = opt_exists opts Dereference > full_time :: MyOptions -> Bool > full_time opts = opt_exists opts FullTime More of the same but which return values, or even functions, rather than bools > screen_width :: MyOptions -> Int > screen_width [] = 80 > screen_width ((Width w):_) = w > screen_width (_:os) = screen_width os > block_size :: MyOptions -> Int > block_size [] = 1024 > block_size ((BlockSize b):_) = b > block_size (_:os) = block_size os > get_human_readable :: MyOptions -> Integer > get_human_readable [] = 0 > get_human_readable ((HumanReadable h):_) = h > get_human_readable (_:os) = get_human_readable os > tabstop :: MyOptions -> Int > tabstop [] = 8 > tabstop ((Tabstop t):_) = t > tabstop (_:os) = tabstop os > get_time_f :: MyOptions -> (FileStatus -> Int) > get_time_f [] = modificationTime > get_time_f (ATime:_) = accessTime > get_time_f (CTime:_) = statusChangeTime > get_time_f (_:os) = get_time_f os ShowBasename can't be set on the command line but we need it when displaying output and this seemed a logical place to put it > addshowbasenames :: MyOptions -> MyOptions > addshowbasenames opts = ShowBasenames:opts > showbasenames :: MyOptions -> Bool > showbasenames opts = opt_exists opts ShowBasenames Does the obvious > stringToInt :: String -> Int > stringToInt s = stoi $ reverse s > where stoi [] = 0 > stoi (c:cs) = (digitToInt c) + 10 * stoi cs Display version and usage > show_version :: IO() > show_version = putStr "ls (IGL fileutils) 4.0.32-0.1.0 Written by Ian Lynagh.\n\nCopyright (C) 2000 Ian Lynagh \nThis is free software; see the source for copying conditions. There is NO\nwarranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" > show_usage :: IO() > show_usage = putStr "Usage: ls [OPTION]... [FILE]...\nList information about the FILEs (the current directory by default).\nSort entries alphabetically if none of -cftuSUX nor --sort.\n\n -a, --all do not hide entries starting with .\n -A, --almost-all do not list implied . and ..\n -b, --escape print octal escapes for nongraphic characters\n --block-size=SIZE use SIZE-byte blocks\n -B, --ignore-backups do not list implied entries ending with ~\n -c with -lt: sort by, and show, ctime (time of last\n modification of file status information)\n with -l: show ctime and sort by name\n otherwise: sort by ctime\n -C list entries by columns\n --color[=WHEN] control whether color is used to distinguish file\n types. WHEN may be `never', `always', or `auto'\n -d, --directory list directory entries instead of contents\n -D, --dired generate output designed for Emacs' dired mode\n -f do not sort, enable -aU, disable -lst\n -F, --classify append indicator (one of */=@|) to entries\n --format=WORD across -x, commas -m, horizontal -x, long -l,\n single-column -1, verbose -l, vertical -C\n --full-time list both full date and full time\n -g (ignored)\n -G, --no-group inhibit display of group information\n -h, --human-readable print sizes in human readable format (e.g., 1K 234M 2G)\n -H, --si likewise, but use powers of 1000 not 1024\n --indicator-style=WORD append indicator with style WORD to entry names:\n none (default), classify (-F), file-type (-p)\n -i, --inode print index number of each file\n -I, --ignore=PATTERN do not list implied entries matching shell PATTERN\n -k, --kilobytes like --block-size=1024\n -l use a long listing format\n -L, --dereference list entries pointed to by symbolic links\n -m fill width with a comma separated list of entries\n -n, --numeric-uid-gid list numeric UIDs and GIDs instead of names\n -N, --literal print raw entry names (don't treat e.g. control\n characters specially)\n -o use long listing format without group info\n -p, --file-type append indicator (one of /=@|) to entries\n -q, --hide-control-chars print ? instead of non graphic characters\n --show-control-chars show non graphic characters as-is (default\n unless program is `ls' and output is a terminal)\n -Q, --quote-name enclose entry names in double quotes\n --quoting-style=WORD use quoting style WORD for entry names:\n literal, locale, shell, shell-always, c, escape\n -r, --reverse reverse order while sorting\n -R, --recursive list subdirectories recursively\n -s, --size print size of each file, in blocks\n -S sort by file size\n --sort=WORD extension -X, none -U, size -S, time -t,\n version -v\n status -c, time -t, atime -u, access -u, use -u\n --time=WORD show time as WORD instead of modification time:\n atime, access, use, ctime or status; use\n specified time as sort key if --sort=time\n -t sort by modification time\n -T, --tabsize=COLS assume tab stops at each COLS instead of 8\n -u with -lt: sort by, and show, access time\n with -l: show access time and sort by name\n otherwise: sort by access time\n -U do not sort; list entries in directory order\n -v sort by version\n -w, --width=COLS assume screen width instead of current value\n -x list entries by lines instead of by columns\n -X sort alphabetically by entry extension\n -1 list one file per line\n --help display this help and exit\n --version output version information and exit\n\nBy default, color is not used to distinguish types of files. That is\nequivalent to using --color=none. Using the --color option without the\noptional WHEN argument is equivalent to using --color=always. With\n--color=auto, color codes are output only if standard output is connected\nto a terminal (tty).\n\nReport bugs to .\n"