Basic Directory / 'Text entry' create / delete / traversal (bash inspired) in Haskell

{-# LANGUAGE TemplateHaskell, ViewPatterns #-}

import Data.Maybe
import Data.List (sortBy,groupBy,elemIndex,intercalate,stripPrefix)
import Data.Function (on)
import System.IO (stdout,hFlush)
import System.Directory (doesFileExist)
import Control.Monad

import Control.Applicative

import Data.Lens.Template (makeLenses)
import Data.Lens.Lazy

data Entry = Entry { _title :: String, _content :: String }
  deriving (Show, Read)

data Directory = Directory 
       { _name :: String, _directories :: [Directory], _entries :: [Entry] }
  deriving (Show, Read)

$( makeLenses [''Directory, ''Entry])

-- Add an entry into the directory tree.
addEntry :: Directory -> [String] -> Entry -> Directory
addEntry dir [] newEntry = addDirectoryEntry dir newEntry
addEntry dir path newEntry = replaceDirectoryInPath dir (tail path) 
                               $ addDirectoryEntry currentDir newEntry
    where currentDir = getCurrentDirectory dir path

-- Add a directory into the directory tree.
addDirectory :: Directory -> [String] -> Directory -> Directory
addDirectory dir [] newDir = addDirectoryDirectory dir newDir
addDirectory dir path newDir = replaceDirectoryInPath dir (tail path) 
                              $ addDirectoryDirectory currentDir newDir
    where currentDir = getCurrentDirectory dir path

-- Remove an entry from the directory tree.
removeEntry :: Directory -> [String] -> Entry -> Directory
removeEntry dir [] e = removeDirectoryEntry dir e
removeEntry dir path e = replaceDirectoryInPath dir (tail path) 
                              $ removeDirectoryEntry currentDir e
    where currentDir = getCurrentDirectory dir path

-- Remove a directory from the directory tree.
removeDirectory :: Directory -> [String] -> Directory -> Directory
removeDirectory dir [] d = removeDirectoryDirectory dir d
removeDirectory dir path d = replaceDirectoryInPath dir (tail path) 
                          $ removeDirectoryDirectory currentDir d
    where currentDir = getCurrentDirectory dir path

-- Add an entry in a directory
addDirectoryEntry :: Directory -> Entry -> Directory
addDirectoryEntry dir e = entries ^%= (sortBy (compare `on` _title)) . (e :) $ dir

-- Add a directory in a directory
addDirectoryDirectory :: Directory -> Directory -> Directory
addDirectoryDirectory dir d = directories ^%= (sortBy (compare `on` _name)) . (d :) $ dir

-- Remove an entry from a directory
removeDirectoryEntry :: Directory -> Entry -> Directory
removeDirectoryEntry dir e =  entries ^%= (filter ((_title e /=) . _title)) $ dir

-- Remove a directory from a directory
removeDirectoryDirectory :: Directory -> Directory -> Directory
removeDirectoryDirectory dir d =  directories ^%= (filter ((_name d /=) . _name)) $ dir

-- Replace a directory in the specified path
-- Input: dir "xxx/yyy/zzz" "aaa"
-- Does: dir' = xxx/yyy/aaa
-- Returns: dir'
replaceDirectoryInPath :: Directory -> [String] -> Directory -> Directory
replaceDirectoryInPath dir [] newDir = addDirectoryDirectory 
                          (removeDirectoryDirectory dir newDir) newDir
replaceDirectoryInPath dir path newDir =
    replaceDirectoryInPath dir (tail path) 
       $ addDirectoryDirectory (removeDirectoryDirectory currentDir newDir) newDir
    where currentDir = getCurrentDirectory dir path

-- Return the last directory specified by path
-- dir "xxx/yyy/zzz" returns zzz
getCurrentDirectory :: Directory -> [String] -> Directory
getCurrentDirectory dir [] = dir
getCurrentDirectory dir path = getCurrentDirectory 
                      $ fromJust (getDirectory dir (last path))) (init path)

-- Return entry from dir by name
getEntry :: Directory -> String -> Maybe Entry
getEntry dir s = if length e > 0 then Just $ head e else Nothing
    where e = filter ((== s) . _title) (_entries dir)

-- Return directory from dir by name
getDirectory :: Directory -> String -> Maybe Directory
getDirectory dir s = if length d > 0 then Just $ head d else Nothing
    where d = filter ((== s) . _name) (_directories dir)

-- -- -- -- -- -- -- -- -- -- -- --
-- The application
-- -- -- -- -- -- -- -- -- -- -- --
filename = "EntryBook.dat"

main :: IO ()
main = loadData filename >>= (\dir -> ls dir >> prompt dir []) >>= saveData filename

-- Prompt
prompt :: Directory -> [String] -> IO Directory
prompt dir path = do    
    putStr $ concat ["/",intercalate "/" (reverse path), "$ "]
    hFlush stdout
    userInput <- getLine

    case strip userInput of
        "exit"  -> return dir
        ""      -> prompt dir path
        xd      -> domore dir path xd 
    where currentDir = getCurrentDirectory dir path
          domore dir path xd = do
            (msg, newDir, newPath) <- dispatch xd dir path
            if msg == "" then
                (ls $ getCurrentDirectory newDir newPath) >> return ()
                else putStrLn msg
            prompt newDir newPath