Skip to content

Instantly share code, notes, and snippets.

@michaelt
Created July 21, 2013 20:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save michaelt/6049771 to your computer and use it in GitHub Desktop.
Save michaelt/6049771 to your computer and use it in GitHub Desktop.
{-# LANGUAGE ScopedTypeVariables #-}
import System.Environment
import Data.Char
import System.IO
import System.Process
import System.Exit
import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
import qualified Control.Exception as C
main = do
script <- getArgs >>= \(file:blather) -> readFile file
ty <- run "ghci" ("-v0" : "-cpp" : "-w" : args) script
putStr ("evaluating Hello.haskellscript\n\n" ++ ty)
where args = ["-XPostfixOperators"]
run :: FilePath -> [String] -> String -> IO String
run file args input = C.handle (\(e :: C.IOException) -> return (show e)) $ do
(inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing
hPutStr inp input >> hClose inp
output <- hGetContents out
errput <- hGetContents err
outMVar <- newEmptyMVar
errMVar <- newEmptyMVar
forkIO (C.evaluate (length output) >> putMVar outMVar ())
forkIO (C.evaluate (length errput) >> putMVar errMVar ())
takeMVar outMVar
takeMVar errMVar
e <- C.catch
(waitForProcess pid)
(\(_ :: C.IOException) -> return ExitSuccess)
return (output ++ errors ++ better errput)
errors = "\n\n**********************************"
better = unlines . map linemanager . lines
where linemanager l =
case (take 13 l, drop 13 l) of
("<interactive>", xs) -> "YOUR SCRIPT DOESNT MAKE SENSE!\n" ++ tail xs
_ -> l
-- file Hello.hscript
"Hello world"
let val = id
let assert = id
let a = 3
val a
let square x = x * x
val $ square 3
square 5
"lets make an assertion: square (-1) == square 1"
assert $ square (-1) == square 1
"no lets just quickcheck it for arbirary n, square (-n) == square n"
import Test.QuickCheck
quickCheck $ \n -> square (-n) == square n
:{
let fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)
:}
"lets do some arbitrary IO!"
hscript <- readFile "Hello.hscript"
"Does this file start with \"Hello world\"?"
assert $ take 13 hscript == "\"Hello world\""
"lets mutate some variables!!"
import Data.IORef
let (?) = readIORef
let (++) = flip modifyIORef (+1)
"lets let x be 1"
x <- newIORef (1 :: Integer)
"whats x?"
(x?)
"let's increment x again"
(x++)
"what's x?"
(x?)
"let's increment x again"
(x++)
"what's x?"
(x?)
"let's increment x again"
(x++)
"what's x?"
(x?)
"wait, fib 13, what was that?"
fib 13
"let's increment x again"
(x++)
(x?)
data Hi = Hi | Ho deriving (Eq,Ord,Show)
:{
let hi Ho = Hi
hi Hi = Ho
:}
assert $ Hi == hi Ho
Hi
import System.Directory
import Control.Monad ((>=>))
d <- getDirectoryContents "." >>= mapM getPermissions
let e = filter executable d
mapM_ print e
$ runhaskell HaskellScript.hs Hello.hscript
evaluating Hello.haskellscript
"Hello world"
3
9
25
"lets make an assertion: square (-1) == square 1"
True
"no lets just quickcheck it for arbirary n, square (-n) == square n"
+++ OK, passed 100 tests.
"lets do some arbitrary IO!"
"Does this file start with \"Hello world\"?"
False
"lets mutate some variables!!"
"lets let x be 1"
"whats x?"
1
"let's increment x again"
"what's x?"
2
"let's increment x again"
"what's x?"
3
"let's increment x again"
"what's x?"
4
"wait, fib 13, what was that?"
233
"let's increment x again"
5
True
Hi
Permissions {readable = True, writable = True, executable = True, searchable = False}
Permissions {readable = True, writable = True, executable = True, searchable = False}
Permissions {readable = True, writable = True, executable = True, searchable = False}
Permissions {readable = True, writable = True, executable = True, searchable = False}
Permissions {readable = True, writable = True, executable = True, searchable = False}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment