{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Main.Rules where

import Control.DeepSeq (deepseq)
import Control.Concurrent
import Control.Exception
import Control.Monad

import Crypto.Hash.SHA1 as Sha1

import qualified Data.ByteString.Lazy as Lbs
import qualified Data.Text.Lazy.IO as Lt
import Data.ByteString (ByteString)
import qualified Data.Text as T
import Data.Foldable (for_)

import Development.Shake.FilePath
import Development.Shake.Classes
import Development.Shake

import Errors

import Frontend.Lexer.Wrapper (runAlex)
import Frontend.Autogen.Parser
import Frontend.Parser.Posn
import Frontend.Syntax.Var
import Frontend.Syntax

import GHC.Generics (Generic)

import Main.Queries

import Rename.Types (FqVar, ModuleId(..), RenamedMod)
import qualified Rename.Types as Rv
import Rename.Rename

import System.IO

import Text.Show.Pretty

findModuleOracle :: Rules ()
findModuleOracle = void $ addOracleCache find where
  find :: AhcModuleFilepath -> Action String
  find (AhcModuleFilepath our_fp (ModId id (Posn sl sc) pe)) = go "" id where
    go fp xs | T.null xs || not (T.singleton '.' `T.isInfixOf` xs) = do
      fp <- pure (fp </> T.unpack xs <.> "hs")
      t <- doesFileExist fp
      unless t . liftIO . throwIO $
        emptyError { errorMessage    = "file does not exist:"
                   , errorFilename   = our_fp
                   , errorBegin      = Posn sl (sc + length fp)
                   , errorEnd        = pe
                   }
      pure fp

    go fp xs = do
      (x, xs) <- pure $ T.span (/= '.') xs
      ex <- doesDirectoryExist (T.unpack x)
      unless ex . liftIO . throwIO $
        emptyError { errorMessage    = "directory in module path does not exist:"
                   , errorFilename   = our_fp
                   , errorBegin      = Posn sl (sc + length fp)
                   , errorEnd        = Posn sl (sc + length fp + T.length x)
                   }
      go (fp </> T.unpack x) xs

  find _ = undefined

parserOracle :: Rules (String -> Action (FeModule ParsedVar))
parserOracle = fmap (. AhcParsedModule) $ addOracleCache (parse . ahcpmFilePath) where
  parse :: String -> Action (FeModule ParsedVar)
  parse fpath = do
    need [fpath]
    fileContents <- liftIO $ Lt.readFile fpath

    let mod = runAlex fpath fileContents parseMod
    () <- liftIO . evaluate $ rnf mod

    case mod of
      Left e -> liftIO $ throwIO e
      Right x -> pure x

renamerOracle :: Rules (String -> Action RenamedMod)
renamerOracle = fmap (. AhcRenamedModule) $ addOracleCache (rename . ahcrnFilePath) where
  rename :: String -> Action RenamedMod
  rename fpath = do
    mod  <- askOracle (AhcParsedModule fpath) :: Action (FeModule ParsedVar)
    hash <- askOracle (AhcModuleHash fpath)
    mvar <- liftIO $ newMVar mempty
    let
      modid = ModuleId { Rv.moduleName = varId $ Frontend.Syntax.moduleName mod
                       , moduleHash = hash
                       , moduleFp = fpath
                       }
      rnctx = RenameCtx { rcOurModId    = modid
                        , rcOurFilePath = fpath
                        , rcScope       = mempty
                        , rcThisModule  = mvar
                        , rcSpanStart   = Posn 1 1
                        , rcSpanEnd     = Posn 1 1
                        }
    runRename (renameModule mod) rnctx

hashOracle :: Rules (String -> Action ByteString)
hashOracle = fmap (. AhcModuleHash) . addOracleCache $ \(AhcModuleHash fp) -> do
  need [fp]
  fileContents <- liftIO $ Lbs.readFile fp
  pure (Sha1.hashlazy fileContents)

compilerRules :: [String] -> Rules ()
compilerRules wanted_mods = do
  findModuleOracle
  parser <- parserOracle
  hash   <- hashOracle
  rename <- renamerOracle

  action $ do
    for_ wanted_mods $ \path -> do
      ast <- rename path
      liftIO $ pPrint ast