content: {-# LANGUAGE CPP                   #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE LambdaCase            #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE UndecidableInstances  #-}
  -- | Parsing of Haskell source files, and error reporting for unparsable files.
  module Language.Haskell.Homplexity.Parse (parseSource, parseTest) where
  
  import           Control.Exception                    as E
  --import Data.Functor
  --import Data.Maybe
  import           Data.Map.Strict                      (Map)
  import qualified Data.Map.Strict                      as Map
  
  import           Language.Haskell.Exts
  --import           Language.Haskell.Exts.SrcLoc
  --import           Language.Haskell.Exts.Syntax
  import           Language.Haskell.Homplexity.Comments
  import           Language.Haskell.Homplexity.Message
  import           Language.Preprocessor.Cpphs
  
  --import HFlags
  
  
  -- | CppHs options that should be compatible with haskell-src-exts
  cppHsOptions ::  CpphsOptions
  cppHsOptions = defaultCpphsOptions {
                   boolopts = defaultBoolOptions {
                                macros    = False,
                                stripEol  = True,
                                stripC89  = True,
                                pragma    = False,
                                hashline  = False,
                                locations = True -- or False if doesn't compile...
                              }
                 }
  
  
  -- | Removes duplicate and switching extensions.
  --
  --   Example:
  --
  --   >>> [ EnableExtension ScopedTypeVariables, DisableExtension ScopedTypeVariables, EnableExtension DoRec ]
  --   [ DisableExtension ScopedTypeVariables, EnableExtension DoRec ]
  --
  collapseSameExtensions :: [Extension] -> [Extension]
  collapseSameExtensions = mkList . foldl processExtension Map.empty
    where
      processExtension :: Map KnownExtension Bool -> Extension -> Map KnownExtension Bool
      processExtension m (UnknownExtension _) = m
      processExtension m (EnableExtension  e) = Map.insert e True  m
      processExtension m (DisableExtension e) = Map.insert e False m
      mkList = map (\case (e, True)  -> EnableExtension e
                          (e, False) -> DisableExtension e
                   )
               . Map.toList
  
  
  mkParseMode :: FilePath -> [Extension] -> ParseMode
  mkParseMode inputFilename extensions = ParseMode
      { parseFilename         = inputFilename
      , baseLanguage          = Haskell2010
      , extensions            = extensions
      , ignoreLanguagePragmas = False
      , ignoreLinePragmas     = False
      , fixities              = Just preludeFixities
      , ignoreFunctionArity   = False
      }
  
  
  parseSourceInternal :: [Extension] -> FilePath -> String -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
  parseSourceInternal additionalExtensions inputFilename inputFileContents = do
      deCppHsInput <- runCpphs cppHsOptions inputFilename inputFileContents
      let fileExtensions = maybe [] snd $ readExtensions deCppHsInput
          extensions     = collapseSameExtensions (additionalExtensions ++ fileExtensions)
          result         = parseModuleWithComments (mkParseMode inputFilename extensions) deCppHsInput
      return result
  
  
  -- | Parse Haskell source file, using CppHs for preprocessing,
  -- and haskell-src-exts for parsing.
  --
  -- Catches all exceptions and wraps them as @Critical@ log messages.
  parseSource :: [Extension] -> FilePath -> IO (Either Log (Module SrcLoc, [CommentLink]))
  parseSource additionalExtensions inputFilename = do
    parseResult <- (    readFile inputFilename
                    >>= parseSourceInternal additionalExtensions inputFilename
                    >>= evaluate)
        `E.catch` handleException (ParseFailed thisFileLoc)
    case parseResult of
      ParseOk (parsed, comments) -> return $ Right (getPointLoc <$> parsed,
                                                    classifyComments comments)
      ParseFailed aLoc msg       -> return $ Left $ critical aLoc msg
    where
      handleException helper (e :: SomeException) = return $ helper $ show e
      thisFileLoc = noLoc { srcFilename = inputFilename }
  
  
  -- | For use in test suite
  parseTest ::  String -> String -> IO (Module SrcLoc, [CommentLink])
  parseTest testId testSource = do
      parseSourceInternal [] testId testSource >>= \case
          ParseOk (parsed, comments) -> return $ (getPointLoc <$> parsed, classifyComments comments)
          other                      -> error $ show other
  