--
-- Insert location-specific exception handlers automatically for the
-- functions:
--
--  fromJust
--  head
--  tail
--
-- Currently you'll need to insert:
--  import Debug.Trace.Location
-- 
-- into any module that you want to rewrite.
--
-- Usage:
--
-- Take a failing program:
-- >    $ ghc --make -Onot A.hs -no-recomp                           
-- >   [1 of 1] Compiling Main             ( A.hs, A.o )
-- >   Linking A ...
-- >   $ ./A
-- >   A: Maybe.fromJust: Nothing
--
-- And rewrite it with the preprocessor:
--
-- >    $ ghc --make -Onot A.hs -no-recomp -pgmF loch -F 
-- >    [1 of 1] Compiling Main             ( A.hs, A.o )
-- >    Linking A ...
-- >    $ ./A
-- >    A: A.hs:14:14-19: Maybe.fromJust: Nothing
--

import Classify
import System.IO
import System.Environment

main = do
    a       <- getArgs
    (f,i,o) <- case a of
                [_,a,b] -> do h1 <- openFile a ReadMode
                              h2 <- openFile b WriteMode
                              return (a,h1,h2)
                _ -> return ("stdin",stdin,stderr)
    src <- hGetContents i
    hPutStr o . header f . render . map rewrite . tokenise $ src
    hFlush o
    hClose i
    hClose o

rewrite :: (TokenType,String) -> (TokenType,String)
rewrite (Varid,"fromJust") = (Varid, "(check assert . fromJust)")
rewrite (Varid,"head")     = (Varid, "(check assert . head)")
rewrite (Varid,"tail")     = (Varid, "(check assert . tail)")
rewrite t = t

render = concatMap renderToken

renderToken :: (TokenType,String) -> String
renderToken (_,s) = s

header f s = "{-# LINE 1 \""++f++ "\" #-}\n" ++ s