Commands.lhs

> module Database.HsSqlPpp.HsText.Commands
>     (defaultCommands
>     ,makeFile
>     ,shell
>     ,wrapCommand
>     ) where

> import Data.Char
> import Data.List
> import System.Exit
> import System.Process (readProcessWithExitCode)
> import System.FilePath

> import Control.Monad.Error


> defaultCommands :: [(String,String -> IO String)]
> defaultCommands = [("file", makeFile)
>                   ,("shell", shell)]

> makeFile :: String -> IO String
> makeFile s =
>   let (fn,content) = break ws $ dropWhile space s
>   in do
>     writeFile fn content
>     return $
>      "File " ++ fn ++ "\n\n"
>      ++ "~~~~~~~~~~~~{" ++ takeExtension fn ++ "}"
>      ++ content ++ "\n~~~~~~~~~~~~\n\n"
>   where
>     ws = (`elem` " \n\t")
>     space = (==' ')

> shell :: String -> IO String
> shell s = {-let (c:as) = words s
>           in -} do
>              (ex,o,e) <- readProcessWithExitCode "bash" ["-c", ("PATH=$PATH:~/wd/hssqlppp/trunk " ++ s)] ""
>              return $ o ++ e ++ case ex of
>                                         ExitSuccess -> ""
>                                         ExitFailure i -> "\nErrorCode: " ++ show i ++ "\n"

PATH=$PATH:~/wd/hssqlppp/trunk && HsSqlSystem

> wrapCommand :: String -> String -> (String -> IO String) -> (String -> IO String)
> wrapCommand pre post c l = c l >>= \m -> return $ pre ++ m ++ post