--
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
-- USA
--

--
-- compile and run haskell strings at runtime.
--

module System.Eval.Utils (

        Import,
        symbol,
        escape,
        getPaths,

        mkUniqueWith,
        cleanup,

        module Data.Maybe,
        module Control.Monad,

    ) where

import System.Plugins.Load                ( Symbol )
import System.Plugins.Utils

import System.IO
import System.Directory

import Data.Char

--
-- we export these so that eval() users have a nice time
--
import Data.Maybe
import Control.Monad

--
-- imports Foo's
--
type Import = String

--
-- distinguished symbol name
--
symbol :: Symbol
symbol :: Symbol
symbol = Symbol
"resource"

--
-- turn a Haskell string into a printable version of the same string
--
escape :: t Char -> Symbol
escape t Char
s = (Char -> Symbol) -> t Char -> Symbol
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
c -> Char -> ShowS
showLitChar Char
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Symbol
"") t Char
s

--
-- For Dynamic eval's, work out the compile and load command lines
--
getPaths :: IO ([String],[String])
getPaths :: IO ([Symbol], [Symbol])
getPaths = do
        let make_line :: [Symbol]
make_line = [Symbol
"-O0",Symbol
"-package",Symbol
"plugins"]
        ([Symbol], [Symbol]) -> IO ([Symbol], [Symbol])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Symbol]
make_line,[])

-- ---------------------------------------------------------------------
-- create the tmp file, and write source into it, using wrapper to
-- create extra .hs src.
--
mkUniqueWith :: (String -> String -> [Import] -> String)
             -> String
             -> [Import] -> IO FilePath

mkUniqueWith :: (Symbol -> Symbol -> [Symbol] -> Symbol)
-> Symbol -> [Symbol] -> IO Symbol
mkUniqueWith Symbol -> Symbol -> [Symbol] -> Symbol
wrapper Symbol
src [Symbol]
mods = do
        (Symbol
tmpf,Handle
hdl) <- IO (Symbol, Handle)
hMkUnique
        let nm :: Symbol
nm   = ShowS
mkModid (ShowS
basename Symbol
tmpf)       -- used as a module name
            src' :: Symbol
src' = Symbol -> Symbol -> [Symbol] -> Symbol
wrapper Symbol
src Symbol
nm [Symbol]
mods
        Handle -> Symbol -> IO ()
hPutStr Handle
hdl Symbol
src' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
hdl IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
hdl IO () -> IO Symbol -> IO Symbol
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Symbol -> IO Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
tmpf

--
-- remove all the tmp files
--
cleanup :: String -> String -> IO ()
cleanup :: Symbol -> Symbol -> IO ()
cleanup Symbol
a Symbol
b = (Symbol -> IO ()) -> [Symbol] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Symbol -> IO ()
removeFile [Symbol
a, Symbol
b, Symbol -> ShowS
replaceSuffix Symbol
b Symbol
".hi"]