A simple line counting tool

lc.hs

{-# LANGUAGE NoImplicitPrelude, GADTs, FlexibleContexts #-}

import Control.Arrow ((***))
import qualified Data.Char as C
import qualified Data.HashMap.Strict as Map
import Data.List (partition)
import System.Directory
import System.FilePath
import Text.Printf
import Universum

explore dir = do
    all <-
        filterM (fmap not . pathIsSymbolicLink) =<<
        map (dir </>) . filter (not . ("." `isPrefixOf`)) <$> listDirectory dir
    areFiles <- mapM doesFileExist all
    let (files, dirs) = (map snd *** map snd) $ partition fst $ zip areFiles all
    (files ++) . concat <$> mapM explore dirs

count file = do
    ct <- readFile file
    let (empty, full) = partition isEmpty $ lines ct
    pure (length empty, length full, sum $ map length full)
  where
    isEmpty = all C.isSpace

-- Needs a single argument for the directory to be searched
main = do
    [dir] <- getArgs
    dirIsFile <- doesFileExist dir
    files <- if dirIsFile then pure [dir] else explore dir
    counts <- mapM count files
    let m =
            Map.fromListWith (++) $
            zip (map takeExtension files) (map pure counts)
    mapM_ printStats (Map.toList m)
    printStats ("total", concat $ Map.elems m)
  where
    printStats (name, counts) = do
        putStrLn $
            if name == ""
                then "none"
                else name
        let empty = sum $ map (\(a, _, _) -> a) counts
            full = sum $ map (\(_, b, _) -> b) counts :: Int
            lengths = map (\(_, _, c) -> c) counts
            all = empty + full :: Int
        printf "  lines: %i (average length: %i)\n" all (sum lengths `div` all)
        printf "  full: %i (%i%%)\n" full (full * 100 `div` all) :: IO ()
        printf "  empty: %i (%i%%)\n" empty (empty * 100 `div` all) :: IO ()