-- if your editor doesn't understand :e +line file 
-- (jump to line in file), you'll need to change 
-- functions find and loadEditErr below
-- :set editor gvim

-- 6.4.1 doesn't have :e, omit this def for later ghci's
:def e \l->return $ "System.system \"vim "++l++"\""

-- 6.6.1 doesn't have :cmd, omit this def for later ghci's
:def cmd \l->return $ unlines [":def cmdTmp \\_->"++l,":cmdTmp",":undef cmdTmp"]

-- make commands helpful
let { cmdHelp cmd msg "--help" = return $ "putStrLn "++show msg; cmdHelp cmd msg other    = cmd other }

:def . cmdHelp readFile ":. <file>\t\t-- source commands from <file>"

let pwd _ = return "System.Directory.getCurrentDirectory >>= putStrLn"

:def pwd cmdHelp pwd ":pwd\t\t\t-- print working directory"

let ls p  = return $ "mapM_ putStrLn =<< System.Directory.getDirectoryContents "++show path where {path = if (null p) then "." else p}

:def ls cmdHelp ls ":ls [<path>]\t\t-- list directory (\".\" by default)"

-- todo: merge redirOut/redirErr, but keep vars/afterCmd distinct, for nesting
let redirOut varcmd = case break Data.Char.isSpace varcmd of { (var,_:cmd) -> return $ unlines ["-- :set -fno-print-bind-result" ,"tmp <- System.Directory.getTemporaryDirectory" ,"(f,h) <- System.IO.openTempFile tmp \"ghci\"" ,"sto <- GHC.Handle.hDuplicate System.IO.stdout" ,"GHC.Handle.hDuplicateTo h System.IO.stdout" ,"System.IO.hClose h" ,cmd ,"GHC.Handle.hDuplicateTo sto System.IO.stdout" ,"let readFileNow f = readFile f >>= \\t->length t `seq` return t" ,var++" <- readFileNow f" ,"System.Directory.removeFile f"] ; _ -> return "putStrLn \"usage: :redirOut <var> <cmd>\"" }

:def redirOut cmdHelp redirOut ":redirOut <var> <cmd>\t-- execute <cmd>, redirecting stdout to <var>"

let redirErr varcmd = case break Data.Char.isSpace varcmd of { (var,_:cmd) -> return $ unlines ["-- :set -fno-print-bind-result" ,"tmp <- System.Directory.getTemporaryDirectory" ,"(f,h) <- System.IO.openTempFile tmp \"ghci\"" ,"ste <- GHC.Handle.hDuplicate System.IO.stderr" ,"GHC.Handle.hDuplicateTo h System.IO.stderr" ,"System.IO.hClose h" ,"let readFileNow f = readFile f >>= \\t->length t `seq` return t" ,"let afterCmd _ = do { GHC.Handle.hDuplicateTo ste System.IO.stderr ; r <- readFileNow f ; System.Directory.removeFile f ; return $ \""++var++" <- return \"++show r }" ,":def afterCmd afterCmd", cmd, ":afterCmd", ":undef afterCmd" ] ; _ -> return "putStrLn \"usage: :redirErr <var> <cmd>\"" }

:def redirErr cmdHelp redirErr ":redirErr <var> <cmd>\t-- execute <cmd>, redirecting stderr to <var>"

let { merge []                    = [] ; merge (l:c:ls) | i c > i l  = merge ((l++c):ls) where {i l = length (takeWhile Data.Char.isSpace l)} ; merge (l:ls)                = l:merge ls ; grep patcmd = case break Data.Char.isSpace patcmd of { (pat,_:cmd) -> return $ unlines [":redirOut out "++cmd ,"let ls = "++if ":browse" `Data.List.isPrefixOf` cmd then "merge (lines out)" else "lines out" ,"let match pat = Data.Maybe.isJust . Text.Regex.matchRegex (Text.Regex.mkRegex pat)" ,"putStrLn $ unlines $ (\"\":) $ filter (match "++show pat++") $ ls"] ; _ -> return "putStrLn \"usage: :grep <pat> <cmd>\"" } }

:def grep cmdHelp grep ":grep <pat> <cmd>\t-- filter lines matching <pat> from the output of <cmd>"
-- (also merges pretty-printed lines if <cmd> is :browse)

let find id = return $ unlines [":redirOut out :info "++id ,"let isInfixOf a b = any (Data.List.isPrefixOf a) (Data.List.tails b)","let ls = filter (isInfixOf \"-- Defined\") $ lines out" ,"let match pat = Text.Regex.matchRegex (Text.Regex.mkRegex pat)" ,"let m = match \"-- Defined at ([^<:]*):([^:]*):\" $ head ls" ,":cmd return $ case (ls,m) of { (_:_,Just [mod,line]) -> (\":e +\"++line++\" \"++mod) ; _ -> \"\" }"]

:def find cmdHelp find ":find <id>\t\t-- call editor (:set editor) on definition of <id>"

let { b browse "" = return $ unlines [":redirOut out :show modules" ,":cmd case lines out of { (l:_) -> return ("++show browse++"++head (words l)); _ -> return \"\" }"] ; b browse m  = return (browse++m) }

:def bd  cmdHelp (b ":browse ") ":bd [<mod>]\t\t-- :browse <mod> (default: first loaded module)"

let loadEditErr m = return $ unlines [if null m then ":redirErr err :reload" else ":redirErr err :load "++m ,"let match pat = Text.Regex.matchRegex (Text.Regex.mkRegex pat)" ,"let ms = Data.Maybe.catMaybes $ map (match \"^([^:]*):([^:]*):([^:]*):\") $ lines err" ,":cmd return $ case ms of { ([mod,line,col]:_) -> (\":e +\"++line++\" \"++mod) ; _ -> \"\" }"]

:def le cmdHelp loadEditErr ":le [<mod>]\t\t-- try to :load <mod> (default to :reload); edit first error, if any"

let { cmds = [".","pwd","ls","redirOut","redirErr","grep","find","bd","le","userdefs"] ; userdefs "list"  = return $ unlines $ "putStrLn \"\"": [":"++cmd++" --help"| cmd <- cmds]++ ["putStrLn \"\""] ; userdefs "undef" = return $ unlines [":undef "++cmd| cmd <- cmds] ; userdefs _       = return "putStrLn \"usage: :userdefs {list,undef}\"" }

:def userdefs cmdHelp userdefs ":userdefs {list,undef}\t-- list or undefine user-defined commands"