content: {-# LANGUAGE ExplicitForAll      #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeOperators       #-}
  
  -- | This module contains functions for parsing /Haskell/ modules also
  -- dealing with @-XCPP@ extension in files.
  
  module Importify.Preprocessor
         ( parseModuleWithPreprocessor
         ) where
  
  import Universum
  
  import Language.Haskell.Exts (Extension, Module, ModulePragma (OptionsPragma),
                                ParseMode (extensions, fixities), SrcSpanInfo, Tool (GHC), defaultParseMode,
                                noLoc)
  import Language.Haskell.Exts.CPP (CpphsOptions (includes), defaultCpphsOptions,
                                    parseFileWithCommentsAndCPP)
  import Path (Abs, File, Path, fromAbsFile, (-<.>))
  import Path.IO (removeFile)
  
  import Importify.ParseException (ModuleParseException (MPE), eitherParseResult)
  import Importify.Syntax (modulePragmas)
  
  import qualified Autoexporter (mainWithArgs)
  
  -- | Parse module after preproccessing this module with possibly
  -- custom preprocessor. It first calls parsing with CPP, then reads
  -- @OPTIONS_GHC@ to handle custom preprocessors. Now only @autoexporter@
  -- supported among all custom preprocessors.
  parseModuleWithPreprocessor
      :: [Extension]    -- ^ List of extensions from .cabal file
      -> [FilePath]     -- ^ Filenames of .h files to include
      -> Path Abs File  -- ^ Path to module
      -> IO $ Either ModuleParseException $ Module SrcSpanInfo
  parseModuleWithPreprocessor extensions includeFiles pathToModule =
      join (errorForcer <$> parseModuleAfterCPP extensions includeFiles pathToModule)
        `catch`
      (fmap Left . cppHandler) >>= \case
        err@(Left _exception)    -> return err
        mdl@(Right parsedModule) -> case autoexportedArgs parsedModule of
          Nothing       -> return mdl
          Just autoArgs -> do
            let modulePath       = fromAbsFile pathToModule
            outputFilePath      <- pathToModule -<.> ".auto"
            let preprocessorArgs = [modulePath, modulePath, fromAbsFile outputFilePath]
            Autoexporter.mainWithArgs (preprocessorArgs ++ autoArgs)
            parseModuleAfterCPP extensions includeFiles outputFilePath
              <* removeFile outputFilePath
    where
      -- This forcer is used because without it @cppHandler@ below doesn't catch exception.
      errorForcer res = evaluateWHNF (show res :: String) >> return res
      {- [IMRF-91]: This exception handler was introduced because
                    of error in filelock-0.1.0.1 package:
  
         importify: #error No backend is available
         in /home/fenx/programming/haskell/serokell/importify/.importify
            /filelock-0.1.0.1/System/FileLock.hs  at line 44 col 1
         CallStack (from HasCallStack):
           error, called at ./Language/Preprocessor/Cpphs/CppIfdef.hs:113:21 in
           cpphs-1.20.8-87uHpRVbMaP4k1m97GGc18:Language.Preprocessor.Cpphs.CppIfdef
      -}
      cppHandler :: SomeException -> IO ModuleParseException
      cppHandler = return . MPE noLoc . show
  
  -- | Parse 'Module' by given 'Path' with given 'Extension's converting
  -- parser errors into human readable text. Some additional handling is
  -- required because @haskell-src-exts@ can't handle @-XCPP@.
  parseModuleAfterCPP :: [Extension]    -- ^ List of extensions from .cabal file
                      -> [FilePath]     -- ^ Filenames of .h files to include
                      -> Path Abs File  -- ^ Path to module
                      -> IO $ Either ModuleParseException $ Module SrcSpanInfo
  parseModuleAfterCPP cabalExtensions includeFiles pathToModule =
       second fst . eitherParseResult
   <$> parseFileWithCommentsAndCPP (defaultCpphsOptions {includes = includeFiles})
                                   (defaultParseMode {extensions = cabalExtensions, fixities = Just []})
                                   (fromAbsFile pathToModule)
  
  autoexportedArgs :: forall l. Module l -> Maybe [String]
  autoexportedArgs = safeHead . mapMaybe autoexporterPragma . modulePragmas
    where
      autoexporterPragma :: ModulePragma l -> Maybe [String]
      autoexporterPragma pragma = do
        OptionsPragma _ tool args <- Just pragma
        GHC <- tool
        "-F":"-pgmF":"autoexporter":autoArgs <- Just $ words $ toText args
        pure $ map toString autoArgs
  