MicroManager metadata file parsing example in Haskell

metadata.hs

-- MicroManager metadata.txt parse example
-- metadata.hs
-- Uses aeson, directory-tree.

{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Data.List
import Data.Maybe
import Data.Tree
import System.Directory
import System.Directory.Tree
import Control.Monad
import Data.Tree

import qualified Data.Traversable as Tr
import Control.Applicative
import Control.Exception

main = do
  root <- getCurrentDirectory
  tree <- dirTree <$> readDirectoryWith onlyMetadata root
  let tree2 = toTree $ catMaybeTree tree :: Tree (String,Maybe Metadata)
  putStrLn $ drawTree $ fmap (\(name,mm) -> name++maybe "" ((": "++) . show) mm) tree2
  where
    f (File "metadata.txt" _) = True
    f _ = False
--  jsons <- catMaybes . flatten <$> Tr.mapM (fmap decode . BS.readFile) $ forest
--  mapM_ process jsons

catMaybeTree :: DirTree (Maybe a) -> DirTree a
catMaybeTree (Dir name cs) = Dir name (catMaybes $ map f cs)
  where
    f (File name (Just a)) = Just $ File name a
    f (File _ _) = Nothing
    f (Dir name cs) = Just $ Dir name $ catMaybes (map f cs)
catMaybeTree (File name (Just file)) = File name file
catMaybeTree (File name Nothing) = Failed name (userError "Nothing appeared in a top level file")
catMaybeTree (Failed name err) = Failed name err

toTree :: DirTree a -> Tree (String,Maybe a)
toTree (File name a) = Node (name,Just a) []
toTree (Dir name cs) = Node (name,Nothing) (map toTree cs)

onlyMetadata :: FilePath -> IO (Maybe Metadata)
onlyMetadata file = do
  if "metadata.txt" `isSuffixOf` file then
    (fmap decode . BS.readFile) file
  else
    return Nothing

data Metadata = Metadata {
  summary :: Summary
} deriving Show

data Summary = Summary {
  numChannels :: Int
} deriving Show

instance FromJSON Metadata where
  parseJSON (Object v) =
    Metadata <$>
      (v .: "Summary")
  parseJSON _ = mzero

instance FromJSON Summary where
  parseJSON (Object v) =
    Summary <$>
      (v .: "Channels")
  parseJSON _ = mzero