Command line tool, listing video files on a local drive

Question

Explanation

I started learning Haskell about a month ago. As an exercise, I recreated a little command line tool, which I had previously written in PowerShell. In the current state, it displays a list of videos in a specific directory and its subdirectories. Later I will add the functionality to play or delete those videos (which should be easy). But the big part is displaying the list. That's all this code does, at the moment.

As much as I like Haskell so far, I'm unhappy with how wordy and complicated this code is. It is 100 lines and seems very hard to read. The PowerShell script is only 70 lines (complete with playback and deletion of videos), less wordy and very easy to read.

Is it mostly due to my lack of knowledge how to write good Haskell code? Or is Haskell not a good tool for this kind of task?

What bothers me in particular:

• I have all those little functions, which do one specific task and call each other to achieve the end goal. This makes it very hard to read the code if one is not familiar with it. Because the functions are not connected in an obvious control structure, one has to analyse each one, see what other function it calls and so forth until the picture is complete.
  Compare this with an imperative language: there are some if statements with easy to read conditions and some large code blocks. At a glance one can see what is done where and if it's of interest, one can look more into the details of the implementation. It's very easy to get a feeling of the overall structure of the program.

• getRecursiveContents (I copied this from the internet). It's huge and complicated. Getting files recursively is such an everyday task - is there really no library function which does this?

• It's nice that I can describe how a custom type should Show itself when printed. But because I'm dealing with lists, I then have to unlines $ map show it, which is not pretty.

Directory structure

└───Videos
    │   Heat.1995.1080p.BRrip.x264.YIFY.mp4
    │   heat.png
    │   leon.png
    │   Leon.the.Professional.Extended.1994.BrRip.x264.YIFY.mp4
    │   mononoke hime.png
    │   Mononoke.hime.[Princess.Mononoke].[DUAL.AUDIO]1997.HDTVRip.x264.YIFY.mkv
    │   Oblivion.2013.1080p.BluRay.x264.YIFY.mp4
    │   oblivion.png
    │   terminator 2.png
    │   Terminator.2.Judgment.Day.1991.DC.1080p.BRrip.x264.GAZ.YIFY.mp4
    │   traffic.png
    │
    └───Series
            S01E01.Some.Show.mp4
            S01E02.Some.Show.mp4
            S01E03.Some.Show.mp4

Output

     Videos
  1  Heat.1995.1080p.BRrip.x264.YIFY
  2  Leon.the.Professional.Extended.1994.BrRip.x264.YIFY
  3  Mononoke.hime.[Princess.Mononoke].[DUAL.AUDIO]1997.HDTVRip.x264.YIFY
  4  Oblivion.2013.1080p.BluRay.x264.YIFY
  5  Terminator.2.Judgment.Day.1991.DC.1080p.BRrip.x264.GAZ.YIFY

     Series
  6  S01E01.Some.Show
  7  S01E02.Some.Show
  8  S01E03.Some.Show

Source

module Main where

import Control.Monad (forM)
import Data.Char (toLower)
import Data.List (isInfixOf, nub, sort, sortBy)
import Data.List.Split (splitOn)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath (takeBaseName, takeDirectory, takeExtension, (</>))
import Text.Printf (printf)


videoDirectory = "C:\\Users\\Swonkie\\Downloads\\Videos"
videoExtensions = [".mp4", ".mkv", ".avi", ".m4v"]

-- ANSI / VT color codes
color = "\ESC[1;31m"
reset = "\ESC[m"

type Library = [Directory]

data Directory = Directory { name  :: String
                           , files :: [Video]
                           }
instance Show Directory where
    show (Directory name files) = "     " ++ color ++ name ++ reset ++ "\n" ++ (unlines $ map show files)

data Video = Video { index  :: Integer
                   , path   :: FilePath
                   }
instance Show Video where
    show (Video i path) = printf "%3d  %s" i (takeBaseName path)


isVideoFile :: FilePath -> Bool
isVideoFile path = takeExtension path `elem` videoExtensions

-- | not used yet
getVideoByIndex :: [Video] -> Integer -> Maybe Video
getVideoByIndex files i =
    if length v > 0
        then Just (head v)
        else Nothing
    where v = filter (\ v -> index v == i) files

-- | not used yet
getVideoByName :: [Video] -> String -> Maybe Video
getVideoByName files s =
    if length v > 0
        then Just (head v)
        else Nothing
    where v = filter (\ v -> isInfixOf (map toLower s) (map toLower $ takeBaseName $ path v)) files


-- | The name of the folder containing the file, without its parent folders.
bottomFolder :: FilePath -> String
bottomFolder path = last $ splitOn "\\" $ takeDirectory path

-- | A list of all unique directory names which appear in the list of videos.
getDirectories :: [Video] -> [String]
getDirectories videos = nub $ map (bottomFolder . path) videos

-- | Filters the list of videos down to only those which are in a specific directory.
getVideosInDirectory :: [Video] -> String -> [Video]
getVideosInDirectory videos name = filter (\ v -> (bottomFolder $ path v) == name) videos

-- | Bundles the videos in a specific directory in a Directory type.
getDirectory :: [Video] -> String -> Directory
getDirectory videos name = Directory name (getVideosInDirectory videos name)

-- | Creates Video objects with indexes
getVideos :: [FilePath] -> [Video]
getVideos list = [Video (fst tp) (snd tp) | tp <- zip [1..] list]

-- | Gets all the directories of the videos and creates a list of Directory types.
getLibrary :: [Video] -> Library
getLibrary videos = map (getDirectory videos) $ getDirectories videos

getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topdir = do
    names <- listDirectory topdir
    paths <- forM names $ \ name -> do
        let path = topdir </> name
        isDirectory <- doesDirectoryExist path
        if isDirectory
            then getRecursiveContents path
            else return [path]
    return (concat paths)

main :: IO ()
main = do
    -- get all video files recursively
    files <- getRecursiveContents videoDirectory    
    let videoFiles = sort $ filter isVideoFile files

    -- adding a character to the end of the path is a hack, to have subdirs sorted below parent dirs
    -- apparently "end of string" is last in the sort order, not first (weird)
    let sortedByDirectory = sortBy (\ a b -> compare (takeDirectory a ++ "$") (takeDirectory b ++ "$")) videoFiles
    let lib = getLibrary $ getVideos sortedByDirectory

    -- show the list of videos
    putStrLn ""
    putStr $ unlines $ map show lib

Answer 1

Welcome to the Haskell programming world. Strap in, it's going to be a ride.

Case study: getVideoBy*

Your functions getVideoByIndex and getVideoByName provide a great case study for improvement. At the moment, both functions look very similar. This brings us to our first principle.

Don't repeat yourself

Both functions work the same we apply filter and then head on the resulting list. We can extract that function into a single one:

find :: (a -> Bool) -> [a] -> Maybe a
find p xs = 
    if length v > 0 
        then Just (head v)
        else Nothing
    where v = filter p xs

-- | not used yet
getVideoByIndex :: [Video] -> Integer -> Maybe Video
getVideoByIndex files i = find (\v -> index v == i) files

-- | not used yet
getVideoByName :: [Video] -> String -> Maybe Video
getVideoByName files s = find (\ v -> isInfixOf (map toLower s) (map toLower $ takeBaseName $ path v)) files

Any improvement on find will now improve both functions at once.

Use null instead of length to check whether a list is empty

Next, we see that you check length v. That's suboptimal, since length is \$\mathcal O(n)\$. Also, it will fail on infinite lists, e.g. length [1..] > 0 will never quit.

Instead, we use null, which is \$\mathcal O(1)\$:

find :: (a -> Bool) -> [a] -> Maybe a
find p xs = 
    if null v
        then Nothing
        else Just (head v)
    where v = filter p xs

Use pattern matching if you're going to use the head

But what happens if we accidentally write the following?

find :: (a -> Bool) -> [a] -> Maybe a
find p xs = 
    if null v
        then Just (head v)
        else Nothing
    where v = filter p xs

Well, that's a bug. We use head on an empty list. Ouch. We can completely remove this kind of error if we use pattern matching instead:

find :: (a -> Bool) -> [a] -> Maybe a
find p xs = 
    case filter p xs of
        (x:_) -> Just x
        _     -> Nothing

Know thy standard library

The function find actually exists. It's exported by Data.List. We can find it easily with Hoogle.

Use collections as last argument

Here are some functions that use a collection as an argument:

foldl  :: (a -> b -> a) -> a -> [b] -> a
foldr  :: (a -> b -> b) -> b -> [a] -> b
filter :: (a -> Bool)   ->      [a] -> Maybe a
map    :: (a -> b)      ->      [a] -> [b]
delete :: Eq a => a     ->      [a] -> [a]
lookup :: Eq a => a     ->  [(a,b)] -> Maybe b

All those functions use the list as the last argument because it enables currying. We should do the same for getVideosBy*:

import Data.List (find, isInfixOf)

-- | not used yet
getVideoByIndex :: Integer -> [Video] -> Maybe Video
getVideoByIndex i = find (\v -> index v == i)

-- | not used yet
getVideoByName :: String -> [Video] -> Maybe Video
getVideoByName s = find (\v -> (map toLower s) `isInfixOf` (map toLower $ takeBaseName $ path v))

Further remarks

I'm not going to apply the remarks above to the rest of the code, that's left as an exercise. Make sure to check the functions in the Prelude, for example getVideos can be written as

-- | Creates Video objects with indexes
getVideos :: [FilePath] -> [Video]
getVideos list = zipWith Video [1..] list
-- or
getVideos = zipWith Video [1..]

Your questions

Little functions

I have all those little functions, which do one specific task and call each other to achieve the end goal. This makes it very hard to read the code if one is not familiar with it.

That's part of Haskell. However, as you can see, getVideoBy is already in the standard library. If you use a function only once, it's sometimes better to inline them, e.g.

-- | Bundles the videos in a specific directory in a Directory type.
getDirectory :: [Video] -> String -> Directory
getDirectory videos name = Directory name $ filter (\ v -> (bottomFolder $ path v) == name) videos

Alternatively, you can use a local binding to keep the name:

-- | Bundles the videos in a specific directory in a Directory type.
getDirectory :: [Video] -> String -> Directory
getDirectory videos name = Directory name (getVideosInDirectory videos name)
  where
    getVideosInDirectory videos name = filter (\ v -> (bottomFolder $ path v) == name) videos

Now that we have a local binding, we don't even have to supply the arguments:

-- | Bundles the videos in a specific directory in a Directory type.
getDirectory :: [Video] -> String -> Directory
getDirectory videos name = Directory name videosInDirectory
  where
    videosInDirectory = filter (\ v -> (bottomFolder $ path v) == name) videos

If we want to keep both functions, they get easier to apply and read if we change the argument order (see "Use collections as last argument" above):

-- | Bundles the videos in a specific directory in a Directory type.
getDirectory :: String -> [Video] -> Directory
getDirectory name videos  = Directory name (getVideosInDirectory name videos)

getVideosInDirectory :: String -> [Video] -> [Video] 
getVideosInDirectory name videos = filter (\ v -> (bottomFolder $ path v) == name) videos

which, as we saw in "Use collections as last argument", can get simplified to

getDirectory :: String -> [Video] -> Directory
getDirectory name = Directory name . getVideosInDirectory name

getVideosInDirectory :: String -> [Video] -> [Video] 
getVideosInDirectory name = filter (\ v -> (bottomFolder $ path v) == name)

unlines . map show

It's nice that I can describe how a custom type should Show itself when printed. But because I'm dealing with lists, I then have to unlines $ map show it, which is not pretty.

You could use

mapM_ print lib

The default Show class is very basic. There is actually only one requirement for Show and Read: any type that derives both automatically has read (show x) == x. If you want to provide pretty formatting, a custom typeclass

class Pretty a where
    pretty :: a -> String

can give you more control. Alternatively, add a newtype around the list, e.g.

newtype WithNewlines t a = WithNewlines { unWithNewLines :: t a }

instance (Show a, Foldable t) => Show (WithNewlines t a) where
  show = unlines . concatMap (pure . show) . unWithNewLines

and then use

putStrLn $ WithNewLines lib

but that's also more or less arcane.

Answer 2

I believe some of the perceived awkwardness comes from the fact that getRecursiveContents throws away the directory structure when building the list of files, and then the code tries to partially reconstruct it in order to print the list.

Another approach would be to use Data.Tree from containers and try to keep the tree structure throughout most of the program, until we generate the final listing.

For example, here's a variant of getRecursiveContents that keeps the directory structure (partitionM from extra would simplify this code):

-- (directory name, files in directory)
getRecursiveContents' :: FilePath -> IO (Tree (FilePath,[FilePath]))
getRecursiveContents' = Data.Tree.unfoldTreeM $ \folder -> do
    names <- listDirectory folder
    -- using partitionM would simplify this a lot, but the function is not in base
    let separate name next =
            do (fs,ds) <- next
               exists <- doesDirectoryExist (folder </> name)
               pure $ if exists then (fs, name:ds)
                                else (name:fs, ds)
    (fs,ds) <- foldr separate (pure ([],[])) names
    --
    pure ((folder, fs), map (folder </>) ds)

We could keep only the videos using:

 keepVideos :: Tree (a,[FilePath]) -> Tree (a,[FilePath])
 keepVideos = fmap (fmap (filter isVideoFile)) -- tree, tuple

The nested fmaps operate inside the tree and the tuple, which are both functors. fmap for tuples works over the second element.

We could also number the files while still on the tree, for example using State to thread a counter across all the lists:

numberFiles :: Tree (a,[b]) -> Tree (a,[(Int,b)])
numberFiles tree =
    let tag b = do n <- get
                   modify succ
                   pure (n,b)
     in evalState (traverse (traverse (traverse tag)) tree) 0 -- tree, tuple, list

The nested traverses work like the nested fmaps, only now there are three of them because we are also traversing the list. traverse for tuples works over the second element.

For generating the final listing, we could use functions from Data.Foldable to process the list of nodes (Trees are Foldable). It should be easy because we have the folder name and the list of files for each node. Trees can also be consumed in a more "structured" way using foldTree, but perhaps that isn't needed here.