    module Agda.Compiler.Alonzo.Haskell where
    import Language.Haskell.Syntax
    import Language.Haskell.Pretty
    import System.IO

    dummyLoc :: SrcLoc
    dummyLoc = SrcLoc "=alonzo=" 0 0

    hsModule :: String -> [HsDecl] -> HsModule
    hsModule name decls = HsModule dummyLoc (Module name) Nothing [] decls

    hsModuleImporting :: String -> [String] -> [String] -> [HsDecl] -> HsModule
    hsModuleImporting name imps qimps decls =
      HsModule dummyLoc (Module name) Nothing
        (map hsImport imps ++ impRTS : impRTP : map hsQImport qimps) decls

    hsImport :: String -> HsImportDecl
    hsImport s = HsImportDecl dummyLoc (Module s) False Nothing Nothing

    hsQImport :: String -> HsImportDecl
    hsQImport s = HsImportDecl dummyLoc (Module s) True Nothing Nothing

    impRTS :: HsImportDecl
    impRTS = hsImport "RTS"

    impRTP :: HsImportDecl
    impRTP = hsQImport "RTP"

    hsUndefined :: HsExp
    hsUndefined = hsVar "undefined"

    hsError :: String -> HsExp
    hsError s = HsApp (hsVar "error") (HsLit $ HsString s)

    hsCast e@(HsVar _) = HsApp (hsVar "cast") e
    hsCast e@(HsCon _) = HsApp (hsVar "cast") e
    hsCast e = HsApp (hsVar "cast") (HsParen e)

    hsVar :: String -> HsExp
    hsVar s = HsVar $ UnQual $ HsIdent s

    hsCon :: String -> HsExp
    hsCon s = HsCon $ UnQual $ HsIdent s

    hsLam :: String -> HsExp -> HsExp
    hsLam n e = HsLambda dummyLoc [HsPVar (HsIdent n)] e

    hsAp :: HsExp -> HsExp -> HsExp
    hsAp e1 e2 =  HsApp (hsCast e1) $ HsParen (hsCast e2)

    outputHsModule s hsmod numOfMainS = do
      handle <- openFile (s++".hs") WriteMode
      printHsModule handle hsmod
      case numOfMainS of
        Nothing -> return ()
        Just i -> printHsMain handle i
      hClose handle

    printHsMain handle i = do
      hPutStrLn handle mainStr where
          -- mainStr = "main = putStrLn d" ++ (show i)
          mainStr = "main = d" ++ show i

    printHsModule :: Handle -> HsModule -> IO ()
    printHsModule handle hsmod = do
    	    hPutStrLn handle "{-# OPTIONS -fglasgow-exts #-}"
    	    hPutStrLn handle ""
    	    hPutStrLn handle "-- Generated by Alonzo"
    	    hPutStrLn handle ""
                hPutStrLn handle $ prettyPrint $ hsmod

    printHsDecls :: [HsDecl] -> IO ()
    printHsDecls ds = mapM_ (putStrLn . prettyPrint) ds

    data AlDecl = AlDecl [HsDecl] | AlComment String

    printAlDecl :: AlDecl -> IO()
    printAlDecl (AlDecl ds) = printHsDecls ds
    printAlDecl (AlComment s) = putStrLn $ "{- "++s++" -}"

    printAlModule :: String -> [AlDecl] -> IO()
    printAlModule name ds = do
    	    putStrLn "{-# OPTIONS -fglasgow-exts -cpp #-}"
    	    putStrLn ""
    	    putStrLn "-- Generated by Alonzo"
    	    putStrLn ""
                putStrLn $ "module " ++ name ++ " where"
                putStrLn "import RTS"
                mapM_ printAlDecl ds

    {-

    type sigs
    HsExp = ...
    HsExpTypeSig SrcLoc HsExp HsQualType

    data HsQualType
    	 = HsQualType HsContext HsType
    type HsContext = [HsAsst]

    HsType = ... HsTyCon HsQName
    -}

    hsTypedExp :: HsQName -> HsExp -> HsExp
    hsTypedExp qn e = HsExpTypeSig dummyLoc e $ HsQualType [] $ HsTyCon qn

    hsPreludeName :: String -> HsQName
    hsPreludeName s = Qual prelude_mod $ HsIdent s

    hsPreludeTypedExp :: String -> HsExp -> HsExp
    hsPreludeTypedExp s e = hsTypedExp (hsPreludeName s) e