Zippers (http://learnyouahaskell.com/zippers)

zippers.hs

import           Control.Monad
import           Data.List                      ( break )
import           Data.Function                  ( (&) )

readList_ :: IO [Int]
readList_ = do
  n <- readLn :: IO Int
  map read . words <$> getLine

data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show)
type Breadcrumbs a = [Crumb a]
type Zipper a  = (Tree a, Breadcrumbs a)
type ListZipper a = ([a], [a])

data FSItem a b = File a b | Folder a [FSItem a b] deriving (Show)
data FSCrumb a b = FSCrumb a [FSItem a b] [FSItem a b] deriving (Show)
type FSZipper a b = (FSItem a b, [FSCrumb a b])


goLeft :: Zipper a -> Maybe (Zipper a)
goLeft (Node x l r, bs) = Just (l, LeftCrumb x r : bs)
goLeft (Empty     , bs) = Nothing

goRight :: Zipper a -> Maybe (Zipper a)
goRight (Node x l r, bs) = Just (r, RightCrumb x l : bs)
goRight (Empty     , bs) = Nothing

goUp :: Zipper a -> Maybe (Zipper a)
goUp (t, LeftCrumb x r : bs ) = Just (Node x t r, bs)
goUp (t, RightCrumb x l : bs) = Just (Node x l t, bs)
goUp (t, []                 ) = Nothing

modify :: (a -> a) -> Zipper a -> Zipper a
modify f (Empty     , bs) = (Empty, bs)
modify f (Node x l r, bs) = (Node (f x) l r, bs)

view :: Zipper a -> Maybe a
view (Empty     , _) = Nothing
view (Node x _ _, _) = Just x

attach :: Tree a -> Zipper a -> Zipper a
attach t (_, bs) = (t, bs)

goForward :: ListZipper a -> Maybe (ListZipper a)
goForward (x : xs, bs) = Just (xs, x : bs)
goForward ([]    , bs) = Nothing

goBack :: ListZipper a -> Maybe (ListZipper a)
goBack (xs, b : bs) = Just (b : xs, bs)
goBack (xs, []    ) = Nothing

fsUp :: FSZipper a b -> Maybe (FSZipper a b)
fsUp (item, (FSCrumb x ls rs) : bs) = Just (Folder x (ls ++ [item] ++ rs), bs)
fsUp (item, []                    ) = Nothing

fsTo :: (FSItem a b -> Bool) -> FSZipper a b -> Maybe (FSZipper a b)
fsTo f (Folder foldername items, bs) =
  let (ls, item : rs) = break f items
  in  Just (item, FSCrumb foldername ls rs : bs)
fsTo _ (File _ _, _) = Nothing

nameIs :: Eq a => a -> FSItem a b -> Bool
nameIs n (File   x _) = x == n
nameIs n (Folder x _) = x == n

fsModify :: (FSItem a b -> FSItem a b) -> FSZipper a b -> FSZipper a b
fsModify f (item, bs) = (f item, bs)

fsNew :: FSItem a b -> FSZipper a b -> Maybe (FSZipper a b)
fsNew item (Folder name items, bs) = Just (Folder name (item : items), bs)
fsNew item (File   _    _    , _ ) = Nothing

fsLs :: FSZipper a b -> a
fsLs (File   name _    , _) = name
fsLs (Folder name items, _) = name

freeTree = Node
  'P'
  (Node 'O'
        (Node 'L' (Node 'N' Empty Empty) (Node 'T' Empty Empty))
        (Node 'Y' (Node 'S' Empty Empty) (Node 'A' Empty Empty))
  )
  (Node 'L'
        (Node 'W' (Node 'C' Empty Empty) (Node 'R' Empty Empty))
        (Node 'A' (Node 'A' Empty Empty) (Node 'C' Empty Empty))
  )

--  return (freeTree , []) >>= goLeft >>= view
--  return (myDisk, []) >>= fsTo (nameIs "pics") >>= return.fsLs

myDisk = Folder
  "root"
  [ File "goat_yelling_like_man.wmv" "baaaaaa"
  , File "pope_time.avi"             "god bless"
  , Folder
    "pics"
    [ File "ape_throwing_up.jpg"  "bleargh"
    , File "watermelon_smash.gif" "smash!!"
    , File "skull_man(scary).bmp" "Yikes!"
    ]
  , File "dijon_poupon.doc" "best mustard"
  , Folder
    "programs"
    [ File "fartwizard.exe"  "10gotofart"
    , File "owl_bandit.dmg"  "mov eax, h00t"
    , File "not_a_virus.exe" "really not a virus"
    , Folder
      "source code"
      [ File "best_hs_prog.hs" "main = print (fix error)"
      , File "random.hs"       "main = print 4"
      ]
    ]
  ]