A Posts lookup on mongoDB database

Extensions.hs

{-# LANGUAGE FlexibleInstances #-}
module Database.MongoDB.Extensions where
  import Database.MongoDB hiding (find)
  import Data.List (find)
  import Control.Monad ((=<<))
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as B

  instance Val (Maybe Value) where
    val Nothing = Null
    val (Just v) = v
    cast' Null = Just Nothing
    cast' v = Just (Just v)

  instance (Val a) => Val (Maybe a) where
    val Nothing = Null
    val (Just a) = val a
    cast' Null = Just Nothing
    cast' v = fmap Just (cast' v)

  look' :: (Monad m) => Label -> Document -> m Value
  look' k doc = maybe (return Null) (return . value) (find ((k==) . label) doc)

  lookup' :: (Val v, Monad m) => Label -> Document -> m v
  lookup' k doc = cast =<< (look' k doc)

Models.hs

{-# LANGUAGE OverloadedStrings #-}
module Posts.Models where
  import Prelude hiding (lookup)
  import Data.Time.Clock (UTCTime)
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as B
  import Control.Monad (mapM)
  import Control.Monad.Trans.Reader
  import Control.Applicative (Applicative(..), (<$>), (<*>))
  import Database.MongoDB
  import Database.MongoDB.Extensions

  data Post = Post {
      title     :: String
    , content   :: String
    , date      :: Maybe UTCTime
    , author    :: Maybe String
  } deriving (Show)

  main :: IO ()
  main = do
    pool <- newConnPool 1 (host "127.0.0.1")
    result <- access safe Master pool dbExec
    print result

  dbExec = use (Database "blog") postsListedByDate 

  documentToPost :: (Monad m, Applicative m) => Document -> m Post
  documentToPost doc = 
    Post <$> (lookup "title"   doc) 
         <*> (lookup "content" doc)
         <*> (lookup "date"    doc)
         <*> (lookup "author"  doc)

  postsListedByDate :: ReaderT Database (Action IO) [Post]
  postsListedByDate = do
    cursor     <- find (select [] "posts") { sort = ["createdAt" =: (1 :: Int)] }
    collection <- rest cursor
    mapM documentToPost collection