Falcon.hs

module Falcon where

import System.Directory
  ( createDirectoryIfMissing
  , doesFileExist
  , getCurrentDirectory
  , getDirectoryContents
  , renameFile
  )
import System.FilePath (hasExtension, joinPath, takeExtension)
import Control.Monad (filterM, forM_)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Text.Printf (printf)


-- | Alias a 'String' to be a 'FileExt' (a file extension, e.g. .txt)
type FileExt = String


-- | Given a 'FilePath' return all existing files in that directory.
getDirectoryFiles :: FilePath -> IO [FilePath]
getDirectoryFiles filePath = do
  contents <- getDirectoryContents filePath
  filterM doesFileExist contents


-- | Organize all files into a 'HashMap' keyed with the file extension.
-- Do this by first pairing each file with its extension in the
-- 'extFilePairs' function. Next, gather them into a list using the `++`
-- function to append 'FilePath's.
filesByExtension :: [FilePath] -> HashMap FileExt [FilePath]
filesByExtension files =
  HashMap.fromListWith (++) (extFilePairs files)


-- | The real workhorse. For each entry in the hash:
--
--     1. Run the preceding action
--     2. Create the directory (and any parents, the 'True' flag)
--     3. For each file in 'files' calculate its new path and move it there
organizeFiles :: FileExt -> [FilePath] -> IO () -> IO ()
organizeFiles ext files action = do
  action
  createDirectoryIfMissing True ext
  forM_ files $ \file -> do
    let path = joinPath [ext, file]
    renameFile file path
    printf "%s -> %s\n" file path


main :: IO ()
main = do
  currDir  <- getCurrentDirectory
  allFiles <- getDirectoryFiles currDir
  let extensionMap = filesByExtension allFiles
  HashMap.foldrWithKey organizeFiles (return ()) extensionMap


-- Helpers


-- | Combine each 'FilePath' into a pair of its extension and a
-- singleton list of the file itself. The list is so that `++`
-- will work as a combining function in `HashMap.fromListWith`.
extFilePairs :: [FilePath] -> [(FileExt, [FilePath])]
extFilePairs files =
  map extFile (filter hasExtension files)
  where
    extFile file =
      (tail (takeExtension file), [file])