module Language.Maude.Exec
(
module Language.Maude.Exec.Types
, rewrite
, search
, runMaude
, defaultConf
) where
import Control.Exception
import Control.Monad (when)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO (hClose)
import System.IO.Temp
import System.Directory (getCurrentDirectory)
import System.Exit
import System.Process.Text (readProcessWithExitCode)
import Text.XML.Light (parseXMLDoc)
import Language.Maude.Exec.Types
import Language.Maude.Exec.XML
rewrite :: [FilePath] -> Text -> IO RewriteResult
rewrite files term = do
let cmd = Rewrite term
maudeResult <- runMaude defaultConf{ loadFiles = files } cmd
let maybeXml = parseXMLDoc $ maudeXmlLog maudeResult
xml <- maybe (throwIO LogToXmlFailure) return maybeXml
case parseRewriteResult xml of
ParseError e s -> throwIO $ XmlToResultFailure s e
Ok a -> return a
search :: [FilePath] -> Text -> Text -> IO SearchResults
search files term pattern = do
let cmd = Search term pattern
maudeResult <- runMaude defaultConf{ loadFiles = files } cmd
let maybeXml = parseXMLDoc $ maudeXmlLog maudeResult
xml <- maybe (throwIO LogToXmlFailure) return maybeXml
case parseSearchResults xml of
ParseError e s -> throwIO $ XmlToResultFailure s e
Ok a -> return a
runMaude :: MaudeConf -> MaudeCommand -> IO MaudeResult
runMaude conf cmd = do
currDir <- getCurrentDirectory
withTempFile currDir "maudelog.xml" $ \xmlFile xmlHandle -> do
hClose xmlHandle
let exe = maudeCmd conf
let args = maudeArgs xmlFile ++ (loadFiles conf)
let input = mkMaudeInput cmd
(exitCode, out, err) <- readProcessWithExitCode exe args input
when (not (T.null err) || exitCode /= ExitSuccess) $
throwIO $ MaudeFailure
{ maudeFailureExitCode = exitCode
, maudeFailureStderr = err
, maudeFailureStdout = out
}
xmlText <- T.readFile xmlFile
return $ MaudeResult
{ maudeStdout = out
, maudeXmlLog = xmlText
}
defaultConf :: MaudeConf
defaultConf = MaudeConf
{ maudeCmd = "maude"
, loadFiles = []
}
maudeArgs :: FilePath -> [String]
maudeArgs xmlFile =
[ "-no-banner"
, "-no-advise"
, "-no-wrap"
, "-no-ansi-color"
, "-xml-log=" ++ xmlFile
]
mkMaudeInput :: MaudeCommand -> Text
mkMaudeInput cmd = T.unlines $
[ "set show command off ."
, showCommand cmd
, " ."
, "quit"
]
showCommand :: MaudeCommand -> Text
showCommand (Rewrite term) = "rewrite " `T.append` term
showCommand (Erewrite term) = "erewrite " `T.append` term
showCommand (Search term pattern) = T.concat ["search ", term, " ", pattern]