> module Main (main) where > import Prelude hiding (catch) > import IO > import Posix > import Exception > import System > import Maybe > import Type_Data > import Library > import Filter > import Sort > import PrettyPrint > import Opts > import Date > import Passwd > import Colour > import Char > import BSD Simple function to catch uncaught exceptions in the real main > main :: IO() > main = catchAllIO real_main > (\e -> putStr ("Uncaught exception:\n" ++ show e ++ "\n")) Try parsing the command line arguments and env variables. Show any errors, show help or versino if required. Otherwise if there are no files and only 1 non-recursive directors (we add "." if none are listed) display it's contents, if there is more than one or it is recursive then display them all with names, and if there are files then show them first followed by any directories with names. > real_main :: IO() > real_main = > do (success, opts, colours, patterns, masks) <- lsopts System.getArgs > case success of > Success -> > do (files, dirs) <- undirify opts (if masks == [] then ["."] else masks) > if files == [] > then if (length dirs == 1) && (not $ isrecursive opts) > then do fl_or_err <- getFileList opts $ head dirs > case fl_or_err of > IsError e -> > putErr e > IsOK filelist -> > showfilelist (addshowbasenames opts) colours patterns filelist > else foldr1 (>>) $ map (showdir (addshowbasenames opts) colours patterns) dirs > else foldl (>>) (showfilelist opts colours patterns files) $ map (showdir (addshowbasenames opts) colours patterns) dirs > Error error -> > putErr "ls: " >> putErr error > >> putErr "\nTry `ls --help' for more information.\n" > ShowUsage -> show_usage > ShowVersion -> show_version Simple wrapper to print things to stderr > putErr :: String -> IO() > putErr = hPutStr stderr Given a list of files, display any that should be displayed sorted as appropriate and print the "No such file or directory" errors > showfilelist :: MyOptions -> [ColourP] -> [Pattern] -> [Mask] -> IO() > showfilelist opts colours patterns filelist > = do (files, errors) <- getmodes opts $ filter (\f -> not $ filter_patterns patterns f) filelist > foldr ((>>).(\f -> putErr "ls: " >> putErr f >> putErr ": No such file or directory\n")) (putStr "") errors > >> (lsfunc opts colours $ filesort opts (sortdir opts) files) undirify takes a list of masks and, unless we are showing directories, returns seperate lists of directories and files > undirify :: MyOptions -> [Mask] -> IO ([Mask], [Mask]) > undirify opts ms = if listdirentries opts > then return (ms, []) > else seperate_dirs opts ms Do the hard work for undirify > seperate_dirs :: MyOptions -> [Mask] -> IO ([Mask], [Mask]) > seperate_dirs _ [] = return ([], []) > seperate_dirs opts (m:ms) > = do (files, dirs) <- seperate_dirs opts ms > maybefilestatus <- tryAllIO (getFileStatus m) > case maybefilestatus of > Left _ -> return (m:files, dirs) > Right f -> > if isDirectory f then return (files, m:dirs) > else return (m:files, dirs) showdir displays a directory contents with directory name and if necessary does so for all it's subdirectories recursively > showdir :: MyOptions -> [ColourP] -> [Pattern] -> Mask -> IO() > showdir opts colours patterns m > = do fl_or_err <- getFileList opts m > case fl_or_err of > IsError e -> > putErr e > IsOK filelist -> > do (_, dirlist) <- seperate_dirs opts filelist > let sort_dirlist = sort (<) dirlist > let showdirs = foldr ((>>).showdir opts colours patterns) (putStr "") > putStr m >> putStr ":\n" > >> showfilelist opts colours patterns filelist > >> if isrecursive opts > then putStr "\n" >> showdirs sort_dirlist > else putStr "\n" getFileList returns the files in a directory or an error if permission was denied > getFileList :: MyOptions -> FilePath -> IO (MaybeError [String]) > getFileList opts fp = do mdirs <- tryAllIO (openDirStream fp) > case mdirs of > Left _ -> > return (IsError ("ls: " ++ fp ++ ": Permission denied\n")) > Right dirs -> > do files <- getEntries dirs > return (IsOK (filterbackups opts $ filterdots opts $ map (\f -> fp ++ ('/':f)) files)) lsfunc reads in the passwd and group files and then flattens all the files from FileInfos to strings ready for outputting. Then it calls prettyPrint to display the output > lsfunc :: MyOptions -> [ColourP] -> [FileInfo] -> IO() > lsfunc opts cols files > = do p <- readfile "/etc/passwd" > g <- readfile "/etc/group" > files' <- flattenall opts cols p g (max_inolen files) (max_blolen files) files > prettyPrint opts files files' Returns the maximum length of inode number when printed out, or 7 if none are that large. e.g. if the inode numbers were 1566854 and 74328695 then it would return 8. > max_inolen :: [FileInfo] -> Int > max_inolen fis > = foldr max 7 $ map (\(_,ino,_,_,_,_) -> length ino) fis Does the same as max_inolen for blocks with a minimum of 4 > max_blolen :: [FileInfo] -> Int > max_blolen fis > = foldr max 4 $ map (\(_,_,blo,_,_,_) -> length $ show blo) fis Return all the files in a directory > getEntries :: DirStream -> IO [FilePath] > getEntries dirstream = do maybefirst <- tryAllIO (readDirStream dirstream) > case maybefirst of > Left _ -> return [] > Right str -> do rest <- getEntries dirstream > return (str:rest) Get the parts of stat on a list of filenames we are interested in and accumulate any errors we get along the way > getmodes :: MyOptions -> [FilePath] -> IO ([FileInfo], [String]) > getmodes _ [] = return ([], []) > getmodes opts (s:ss) > = do (files, errors) <- getmodes opts ss > let fileStatf = if dereference_symlinks opts > then (\f -> do mfs <- tryAllIO $ getFileStatus f > case mfs of > Left _ -> getlFileStatus f > Right fs -> return fs > ) > else getlFileStatus > maybefilestatus <- tryAllIO $ fileStatf s > case maybefilestatus of > Left _ -> return (files, s:errors) > Right f -> return ((getmode opts s f):files, errors) Do the hardwork for the above function on a single file > getmode :: MyOptions -> FilePath -> FileStatus -> FileInfo > getmode opts fn fs = (size, ino, blo, date', fn, fs) > where date' = toInteger $ get_time_f opts fs > size = fileSize fs > ino = show $ fileID fs > bl = fileBlocks fs > bs = fileBlockSize fs > bs_out = block_size opts > blo = if isLink fs then 0 > else ((div ((bl * bs) - 1) (bs_out * 8)) + 1) Given a list of FileInfos and the other necessary information, flatten the list into a list of strings ready for output and the length of each string (not including the ANSI escape sequences that don't take up screen space) > flattenall :: MyOptions -> [ColourP] -> File -> File -> Int -> Int -> [FileInfo] -> IO [(String, Int)] > flattenall _ _ _ _ _ _ [] = return [] > flattenall opts cols p g inolen blolen (x:xs) > = do y <- flatten opts cols p g x inolen blolen > rest <- flattenall opts cols p g inolen blolen xs > return (y:rest) Function between the previous and following function to add the link information if relevent > flatten :: MyOptions -> [ColourP] -> File -> File -> FileInfo -> Int -> Int -> IO (String, Int) > flatten opts cols p g (sz, ino, blo, secs, fn, fs) inolen blolen > = do d <- date opts secs > (mfnl, mfsl) <- if isLink fs > then do fnl <- readlink fn > maybe_fsl <- tryAllIO $ getFileStatus fnl > case maybe_fsl of > Left _ -> return (Just fnl, Nothing) > Right fsl -> return (Just fnl, Just fsl) > else return (Nothing, Nothing) > return $ flatten_file opts cols p g (sz, ino, blo, secs, fn, fs) mfnl mfsl d inolen blolen Flatten a single FileInfo for flattenall > flatten_file :: MyOptions -> [ColourP] -> File -> File -> FileInfo > -> Maybe FilePath -> Maybe FileStatus > -> String -> Int -> Int -> (String, Int) > flatten_file opts cols p g (sz, ino, blo', _, fn, fs) mfnl mfsl d inolen blolen > = (foldr1 (\x y -> x ++ (' ':y)) list6, fn_len') > where no_s_g = no_show_group opts > perm m n = nullFileMode /= (intersectFileModes m n) > fm = fileMode fs > firsts = [(isDirectory, 'd'), > (isRegularFile ,'-'), > (isLink ,'l'), > (isSocket ,'s'), > (isCharacterDevice ,'c'), > (isBlockDevice ,'b'), > (isNamedPipe ,'p')] > getc [] = Nothing > getc ((i, c):xs) = if i fs then Just c else getc xs > getc1 f1 true false = if f1 fm then true else false > getc2 f1 f2 tt tf ft ff = if f1 fm then getc1 f2 tt tf > else getc1 f2 ft ff > mode = case getc firsts of > Just c -> [c] > Nothing -> "" > ++ getc1 (perm ownerReadMode) "r" "-" > ++ getc1 (perm ownerWriteMode) "w" "-" > ++ getc2 (perm ownerExecuteMode) (perm setUserIDMode) > "s" "x" "S" "-" > ++ getc1 (perm groupReadMode) "r" "-" > ++ getc1 (perm groupWriteMode) "w" "-" > ++ getc2 (perm groupExecuteMode) (perm setGroupIDMode) > "s" "x" "S" "-" > ++ getc1 (perm otherReadMode) "r" "-" > ++ getc1 (perm otherWriteMode) "w" "-" > ++ getc2 (perm otherExecuteMode) (perm stickyBitMode) > "t" "x" "T" "-" > lc = linkCount fs > uid = fileOwner fs > gid = fileGroup fs > lcstr = show lc > linkc = takep (4 - length lcstr) (repeat ' ') ++ lcstr > ow = if numeric_ids opts then show uid else id_to_name uid p > owner = ow ++ takep (8 - length ow) (repeat ' ') > gr = if numeric_ids opts then show gid else id_to_name gid g > group = gr ++ takep (8 - length gr) (repeat ' ') > hum_rd = get_human_readable opts > sizestr = if hum_rd == 0 then show sz else humanify sz hum_rd > size = takep (8 - length sizestr) (repeat ' ') ++ sizestr > (maj', min') = divMod (rdeviceID fs) 256 > maj'' = show maj' > min'' = show min' > maj = takep (3 - length maj'') (repeat ' ') ++ maj'' > min = takep (4 - length min'') (repeat ' ') ++ min'' > device = maj ++ ',':min > inode = takep (inolen - length ino) (repeat ' ') ++ ino > blo = show blo' > blocks = takep (blolen - length blo) (repeat ' ') ++ blo > (fn', fnl') = mangle_filename opts cols (Just fn) (Just fs) mfsl > (fn'', fnl'') = mangle_filename opts cols mfnl mfsl Nothing > (fn''', fnl''') = if isLink fs && long_output opts > then (fn' ++ " -> " ++ fn'', fnl' + 4 + fnl'') > else (fn', fnl') > fn_len = if show_inodes opts then inolen + 1 + fnl''' > else fnl''' > fn_len' = if show_blocksize opts then blolen + 1 + fn_len > else fn_len > list1 = [d, fn'''] > list2 = if isBlockDevice fs || isCharacterDevice fs > then device:list1 > else size:list1 > list3 = if not no_s_g then group:list2 else list2 > list4 = if long_output opts then mode:linkc:owner:list3 > else [fn'''] > list5 = if show_blocksize opts then blocks:list4 else list4 > list6 = if show_inodes opts then inode:list5 else list5 Stick stuff around a filename for colour and classification > mangle_filename :: MyOptions -> [ColourP] -> Maybe FilePath > -> Maybe FileStatus -> Maybe FileStatus > -> (String, Int) > mangle_filename opts cols mfn mfs mfsl = (fn6, fl) > where fn = case mfn of > Just f -> f > Nothing -> "" > fn0 = if showbasenames opts then basename fn else fn > fn1 = if quote_names opts > then "\"" ++ foldr escape_quote_c "" fn0 ++ "\"" > else fn0 > fn2 = if raw_characters opts then fn1 > else foldr escape_func "" fn1 > escape_func = if escape_characters opts then escape else normal > fn3 = if colour_output opts > then case getc colours of > Just c -> (getcol cols c) ++ fn2 > Nothing -> fn2 > else fn2 > fn4 = if colour_output opts then (getcolmask cols fn) ++ fn3 > else fn3 > fn5 = if colour_output opts then fn4 ++ (getcol cols "no") > else fn4 > fn6 = if classify_filenames opts || classify_most_filenames opts > then case classification of > Just c -> fn5 ++ c > Nothing -> fn5 > else fn5 > fl = case classification of > Just _ -> length fn2 + 1 > Nothing -> length fn2 > getc [] = Nothing > getc ((i, c):xs) = case mfs of > Just fs -> if i fs then Just c else getc xs > Nothing -> Nothing > isExecutable q = or $ map > (\x -> nullFileMode /= intersectFileModes x (fileMode q)) > [ownerExecuteMode, groupExecuteMode, otherExecuteMode] > colours = [((\f -> isLink f && mfsl == Nothing), "or"), > (isLink, "ln"), > (isDirectory, "di"), > (isCharacterDevice, "cd"), > (isBlockDevice, "bd"), > (isNamedPipe, "pi"), > (isSocket, "so"), > (isExecutable, "ex")] > classification = if classify_filenames opts > then getc classifications > else if classify_most_filenames opts > then getc $ init classifications > else Nothing > classifications > = [(isDirectory ,"/"), > ((\f -> isLink f && (not $ long_output opts)),"@"), > (isSocket ,"="), > (isNamedPipe ,"|"), > ((\f -> (not $ isLink f) && isExecutable f), "*")] Put quotes around a filename and escape quotes in the middle of it > escape_quote_c :: Char -> String -> String > escape_quote_c '\"' s = "\\\"" ++ s > escape_quote_c c s = c:s Replace non-printable characters with ?s > normal :: Char -> String -> String > normal c s = if (d < 32) || (d > 126) then '?':s else c:s > where d = ord c Escape various characters in a string in various ways > escape :: Char -> String -> String > escape c s = case d of > 7 -> "\\a" ++ s > 8 -> "\\b" ++ s > 9 -> "\\t" ++ s > 10 -> "\\n" ++ s > 11 -> "\\v" ++ s > 12 -> "\\f" ++ s > 13 -> "\\r" ++ s > 32 -> "\\ " ++ s > 92 -> "\\\\" ++ s > _ -> if (d < 7) || ((d > 13) && (d < 32)) || (d > 126) > then '\\':octal3 d ++ s > else c:s > where d = ord c Converts an integer into octal and returns it as a string so long as the integer is no more than 3 octal digits > octal3 :: Int -> String > octal3 n = concat $ map show [d2, d1, d0] > where (n', d0) = divMod n 8 > (d2, d1) = divMod n' 8 Given a number convert it into a number of M, say. Need to pass it 1024 or 1000 as the second parameter depending on what you want. > humanify :: Int -> Integer -> String > humanify size block = get_suf pow_suf > where sz = toInteger size > pow_suf = [(4, "T"), (3, "G"), (2, "M"), (1, "k")] :: [(Int, String)] > get_suf ((p, s):pss) = > if sz >= (block ^ p) > then (shownum $ divMod (div (10 * sz) (block ^ p)) 10) ++ s > else get_suf pss > get_suf [] = show size > shownum (n, m) = if n < 10 then show n ++ "." ++ show m > else show n