module Preprocessor where

import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.Pretty
import Language.Haskell.Exts.Parser hiding (parse)
import Language.Haskell.Exts.Extension

import System.Directory

import Control.Monad

preprocess :: FilePath -> IO ()
preprocess file = do
     p <- parse file
     case p of
       (ParseOk mod)          -> confirm "Do preprocessing?" (doit mod)
       (ParseFailed sloc msg) -> parseFail sloc msg 
     where
     doit mod  = renameFile file (file ++ ".orig") >>
                 writeFile file (prettyPrint $ convert mod)
     parseFail sloc msg =  
          putStrLn $ "Parsing failed at " ++ (show sloc) ++ 
                    " with message: " ++  msg  ++ 
                    "\nMaybe This is not supported by Igor."
        
parse :: FilePath -> IO (ParseResult Module)
parse s = 
   let mode = defaultParseMode{ parseFilename = s
                              , extensions    = [TypeOperators
                                                ,TypeFamilies]} in 
   readFile s >>= return . (parseModuleWithMode mode)

-- Asks for confirmation with String 'str' to perform IO action 'io'
confirm :: String -> IO () -> IO ()
confirm str io = 
    putStrLn str >> putStrLn "[Y|n]" >> getLine >>= \i -> 
      case i of 
        "Y" -> putStrLn "Okay, I,ll do it!" >> io
        _   -> putStrLn "Abort"
           
-- TODO
{- |
   Modifies a module and does following conversions:
     * for Int(eger)s 
       - convert to Peano
       - add "data Peano = Z | S Peano deriving Show"
     * for inductive data types (data Ty x = A | B x | C x Ty)
       - add {-# OPTIONS_GHC -XTypeOperators -XTypeFamilies  #-} 
         to options
       - add type instance
         type instance PF (Ty x) = Const One :+: 
                                   (Const x) :+:
                                   (Const x :*: Id)
       - add instance declaration
         instance Mu (List a) where
           inn (Left _)               = A
           inn (Right (Left x))       = B x
           inn (Right (Right (x,ty))) = C x ty
           out A                      = Left _L
           out (B x)                  = Right (Left x)   
           out (C x ty)               = Right (Right (x,ty))
-}
convert :: Module -> Module
convert = id

-- TODO
{- |   
   Check if the given module needs preprocessing, i.e. it contains
     * Int(eger)s
     * inductive types (data Ty = A | B x | C Ty)
-}
needPpr :: Module -> Bool
needPpr mod = True