Useful REPL utils for Yesod (as well as some generally useful functions!)

.ghci

:set -i.:config:dist/build/autogen
:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable

import Prelude
import Control.Applicative
import Data.Char
import Data.List
import qualified Data.Text as T
import Data.Text (Text)

--{- Use with HsDev
import Control.Monad.Error
import HsDev.Tools.Hayoo
:{
let
    showHayooFunction f =
        (hayooName f ++ " :: " ++ hayooSignature f) :
        (map ('\t':) $
            lines (untagDescription (hayooDescription f)) ++
            ["-- Defined in '" ++ hayooModule f ++ "', " ++ hayooPackage f])
    showHayoo = concatMap showHayooFunction . hayooFunctions
:}
:def hayoo \s -> return $ "runErrorT (hayoo \"" ++ s ++ "\") >>= (mapM_ putStrLn) . either (return . (\"Error: \" ++)) showHayoo"
--}

--{ TODO: From https://github.com/jkozlowski/thebook-haskell/blob/master/.ghci
-- Watching for changes and testing automatically
import System.FSNotify
import Data.String
import Control.Concurrent.MVar
import Control.Concurrent

:{
:def test const (withManager (\manager -> 
     do putStrLn "Listening to changes, press any key to stop..."
        lock <- newEmptyMVar
        watchTree manager (fromString ".") (const True) (const $ putMVar lock True)
        forkIO (getLine >> putMVar lock False)
        rerun <- readMVar lock
        return $ if rerun 
          then ":reload \n :main \n :test"
          else ""
     ))
:}
--}

:set prompt "λ "
:def hlint const . return $ ":! hlint \"src\""
:def hoogle \s -> return $ ":! hoogle --count=15 \"" ++ s ++ "\""
:def doc    \x -> return $ ":!hoogle --info \"" ++ x ++ "\""
:def pl \s -> return $ ":! pointfree \"" ++ s ++ "\""

{- Usage:

λ :hayoo (a -> c) -> (b -> c)
either :: (a -> c) -> (b -> c) -> Either a b -> c
    Case analysis for the Either type.
     If the value is Left a, apply the first function to a;
     if it is Right b, apply the second function to b.
    -- Defined in 'Prelude', base

-}

ApplicationRepl.hs

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module ApplicationRepl where
import qualified Data.Map as M
import Import
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import Network.Wai.Logger (clockDateCacher)
import Yesod.Default.Main as YD
import Yesod.Default.Config as YD
import Yesod.Core.Types as YC
--import Yesod.Test as YT
import Database.Persist.Sql (SqlPersistT)
import Application

-- TODO: Look at using Yesod.Test.doRequest instead. See https://github.com/yesodweb/yesod/issues/718

mkRunHandler :: IO (Handler Value -> IO (Either ErrorResponse Value))
mkRunHandler = do
  config <- YD.loadConfig (configSettings Development) { csParseExtra = parseExtra }
  site <- makeFoundation config
  (getter, updater) <- clockDateCacher
  loggerSet' <- newStdoutLoggerSet defaultBufSize
  let logger = YC.Logger loggerSet' (updater >> getter)
  return $ runFakeHandler M.empty (\_ -> logger) site

mkRunDB :: IO (SqlPersistT Handler (Maybe (Entity a)) -> IO (Maybe (Entity a)))
mkRunDB = error "TODO"

{- Usage:

λ :l ApplicationRepl
λ runHandler <- mkRunHandler
λ runHandler $ getRouteR "Foo...."
λ runDB <- mkRunDB
λ runDB findObject "Foo"

-}

For anyone looking at this, might be worth moving the ApplicationRepl.hs contents into the devel.hs file generated by the scaffold instead and then load that in ghci. That file looks a little bit similar to https://github.com/chrisdone/ghci-reload-demo which has even more stuff that looks really useful.