content: module TestUtils
         ( compareFiles
         , parsedFileGhc
         , parsedFileGhcCd
         , parseSourceFileTest
         , runLogTestGhc
         , runTestGhc
         , runRefactGhcState
         , runRefactGhcStateLog
         , initialState
         , initialLogOnState
         , showAnnDataFromState
         , showAnnDataItemFromState
         , showAnnsFromState
         , exactPrintFromState
         , sourceFromState
         , annsFromState
         , defaultTestSettings
         , logTestSettings
         , testOptions
         , catchException
         , mkTokenCache
         , hex
         , unspace
         , mkTestGhcName
         , setLogger
         , cdAndDo
         , ct
         , pwd
         , cd
         , parseToAnnotated
         , parseDeclToAnnotated
         , ss2span
         , PosToken
         , getHsDecls
         , showNameMap
         ) where
  
  
  import qualified DynFlags      as GHC
  import qualified FastString    as GHC
  import qualified GHC           as GHC
  import qualified Name          as GHC
  import qualified Outputable    as GHC
  import qualified Unique        as GHC
  
  import Data.Algorithm.Diff
  import Data.Algorithm.DiffOutput
  import Data.Data
  import Exception
  import Language.Haskell.GHC.ExactPrint
  import Language.Haskell.GHC.ExactPrint.Annotate
  import Language.Haskell.GHC.ExactPrint.Parsers
  import Language.Haskell.GHC.ExactPrint.Types
  import Language.Haskell.GHC.ExactPrint.Utils
  import qualified GhcMod       as GM
  import qualified GhcMod.Types as GM
  import Language.Haskell.Refact.Utils.Monad
  import Language.Haskell.Refact.Utils.MonadFunctions
  import Language.Haskell.Refact.Utils.Types
  import Language.Haskell.Refact.Utils.Utils
  import Numeric
  import System.Directory
  import System.Log.Handler.Simple
  import System.Log.Logger
  
  import qualified Data.Map as Map
  -- import Control.Monad.IO.Class
  
  -- ---------------------------------------------------------------------
  
  type PosToken = (GHC.Located GHC.Token, String)
  
  pwd :: IO FilePath
  pwd = getCurrentDirectory
  
  cd :: FilePath -> IO ()
  cd = setCurrentDirectory
  
  -- ---------------------------------------------------------------------
  
  hex :: Int -> String
  hex v = "0x" ++ showHex v ""
  
  -- ---------------------------------------------------------------------
  
  compareFiles :: FilePath -> FilePath -> IO String
  compareFiles fileA fileB = do
    astr <- readFile fileA
    bstr <- readFile fileB
    let
      diffToString ds = case ppDiff ds of
        "\n" -> ""
        s    -> s
    return $ diffToString $ getGroupedDiff (lines astr) (lines bstr)
  
  -- ---------------------------------------------------------------------
  
  parsedFileGhc :: String -> IO ParseResult
  parsedFileGhc fileName = do
    let
      comp = do
         -- logm $ "parsedFileGhc:fileName" ++ show fileName
         res <- parseSourceFileTest fileName
         -- logm $ "parsedFileGhc:done"
         return res
    (parseResult,_s) <- runRefactGhcStateLog comp Normal
    -- (parseResult,_s) <- runRefactGhcStateLog comp Debug
    return parseResult
  
  -- ---------------------------------------------------------------------
  
  parsedFileGhcCd :: FilePath -> FilePath -> IO ParseResult
  parsedFileGhcCd path fileName = do
    old <- getCurrentDirectory
    let
      comp = do
         res <- parseSourceFileTest fileName
         return res
      newDir = setCurrentDirectory path
      oldDir _ = setCurrentDirectory old
    (parseResult,_s) <- GHC.gbracket newDir oldDir $ \_ -> runRefactGhcState comp
    return parseResult
  
  -- ---------------------------------------------------------------------
  
  ct :: IO a -> IO a
  ct = cdAndDo "./test/testdata/"
  
  cdAndDo :: FilePath -> IO a -> IO a
  cdAndDo path fn = do
    old <- getCurrentDirectory
    r <- GHC.gbracket (setCurrentDirectory path) (\_ -> setCurrentDirectory old)
            $ \_ -> fn
    return r
  
  -- ---------------------------------------------------------------------
  
  parseSourceFileTest :: FilePath -> RefactGhc ParseResult
  parseSourceFileTest fileName = do
    parseSourceFileGhc fileName -- Load the file first
    getTypecheckedModule
  
  -- ---------------------------------------------------------------------
  
  initialState :: RefactState
  initialState = RefSt
    { rsSettings = defaultTestSettings
    , rsUniqState = 1
    , rsSrcSpanCol = 1
    , rsFlags = RefFlags False
    , rsStorage = StorageNone
    , rsCurrentTarget = Nothing
    , rsModule = Nothing
    }
  
  -- ---------------------------------------------------------------------
  
  initialLogOnState :: RefactState
  initialLogOnState = RefSt
    { rsSettings = logTestSettings
    , rsUniqState = 1
    , rsSrcSpanCol = 1
    , rsFlags = RefFlags False
    , rsStorage = StorageNone
    , rsCurrentTarget = Nothing
    , rsModule = Nothing
    }
  
  -- ---------------------------------------------------------------------
  
  mkTokenCache :: a -> TokenCache a
  mkTokenCache forest = TK (Map.fromList [((TId 0),forest)]) (TId 0)
  
  -- ---------------------------------------------------------------------
  
  runTestInternal :: RefactGhc a -> RefactState -> GM.Options
                  -> IO (a, RefactState)
  runTestInternal comp st opts =
    runRefactGhc comp st opts
  
  -- ---------------------------------------------------------------------
  
  runLogTestGhc :: RefactGhc a -> IO (a, RefactState)
  runLogTestGhc comp =
     runTestInternal comp initialLogOnState testOptions
  
  -- ---------------------------------------------------------------------
  
  runTestGhc :: RefactGhc a -> IO (a, RefactState)
  runTestGhc comp = do
     runTestInternal comp initialState testOptions
  
  -- ---------------------------------------------------------------------
  
  runRefactGhcState :: RefactGhc t -> IO (t, RefactState)
  runRefactGhcState comp = runRefactGhcStateLog comp Normal
  
  -- ---------------------------------------------------------------------
  
  runRefactGhcStateLog :: RefactGhc t -> VerboseLevel -> IO (t, RefactState)
  runRefactGhcStateLog comp logOn  = do
    let
       initState = RefSt
          { rsSettings = defaultTestSettings { rsetVerboseLevel = logOn }
          , rsUniqState = 1
          , rsSrcSpanCol = 1
          , rsFlags = RefFlags False
          , rsStorage = StorageNone
          , rsCurrentTarget = Nothing
          , rsModule = Nothing
          }
    -- putStrLn $ "runRefactGhcStateLog:initState=" ++ show initState
    -- putStrLn $ "runRefactGhcStateLog:testOptions=" ++ show testOptions
    runTestInternal comp initState testOptions
  
  -- ---------------------------------------------------------------------
  
  testOptions :: GM.Options
  -- testOptions = GM.defaultOptions { GM.ooptLogLevel = GM.GmError }
  testOptions = GM.defaultOptions {
      GM.optOutput     = GM.OutputOpts {
        GM.ooptLogLevel       = GM.GmError
        -- GM.ooptLogLevel       = GM.GmVomit
      , GM.ooptStyle          = GM.PlainStyle
      , GM.ooptLineSeparator  = GM.LineSeparator "\0"
      , GM.ooptLinePrefix     = Nothing
      }
  
      }
  
  -- ---------------------------------------------------------------------
  
  defaultTestSettings :: RefactSettings
  defaultTestSettings = defaultSettings { rsetVerboseLevel = Normal }
  
  logTestSettings :: RefactSettings
  logTestSettings = defaultSettings { rsetVerboseLevel = Debug }
  
  -- ---------------------------------------------------------------------
  
  catchException :: (IO t) -> IO (Maybe String)
  catchException f = do
    res <- handle handler (f >> return Nothing)
    return res
    where
      handler:: SomeException -> IO (Maybe String)
      handler e = return (Just (stripCallStack $ show e))
  
  -- ---------------------------------------------------------------------
  
  showAnnDataFromState :: RefactState -> String
  showAnnDataFromState st =
    case rsModule st of
      Just tm -> r
        where
          anns = tkCache (rsTokenCache tm) Map.! mainTid
          parsed = GHC.pm_parsed_source $ tmParsedModule
                   $ rsTypecheckedMod tm
          r = showAnnData anns 0 parsed
      Nothing -> []
  
  -- ---------------------------------------------------------------------
  
  showAnnDataItemFromState :: (Data a) => RefactState -> a -> String
  showAnnDataItemFromState st t =
    case rsModule st of
      Just tm -> r
        where
          anns = tkCache (rsTokenCache tm) Map.! mainTid
          r = showAnnData anns 0 t
      Nothing -> []
  
  -- ---------------------------------------------------------------------
  
  showAnnsFromState :: RefactState -> String
  showAnnsFromState st =
    case rsModule st of
      Just tm -> r
        where
          anns = tkCache (rsTokenCache tm) Map.! mainTid
          r = showGhc anns
      Nothing -> []
  
  -- ---------------------------------------------------------------------
  
  exactPrintFromState :: (Annotate a) => RefactState -> GHC.Located a -> String
  exactPrintFromState st ast =
    case rsModule st of
      Just tm -> r
        where
          -- anns = tkCache (rsTokenCache tm) Map.! mainTid
          anns = case Map.lookup mainTid (tkCache (rsTokenCache tm)) of
            Just a -> a
            Nothing -> error $ "exactPrintFromState:mainTid not found"
          r = exactPrint ast anns
      Nothing -> []
  
  -- ---------------------------------------------------------------------
  
  sourceFromState :: RefactState -> String
  sourceFromState st =
    case rsModule st of
      Just tm -> r
        where
          anns = tkCache (rsTokenCache tm) Map.! mainTid
          parsed = GHC.pm_parsed_source $ tmParsedModule
                   $ rsTypecheckedMod tm
          r = exactPrint parsed anns
      Nothing -> []
  
  -- ---------------------------------------------------------------------
  
  annsFromState :: RefactState -> Anns
  annsFromState st =
    case rsModule st of
      Just tm -> tkCache (rsTokenCache tm) Map.! mainTid
      Nothing -> error $ "annsFromState: no rsModule"
  
  -- ---------------------------------------------------------------------
  
  setLogger :: IO ()
  setLogger = do
    {-
    h <- fileHandler "debug.log" DEBUG >>= \lh -> return $
                   setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")
    updateGlobalLogger "MyApp.BuggyComponent" (addHandler h)
    -}
  
    -- s <- streamHandler stdout DEBUG
    h <- fileHandler "debug.log" DEBUG
    updateGlobalLogger rootLoggerName (setHandlers [h])
  
  -- ---------------------------------------------------------------------
  
  -- |Convert any sequence of more than one space to a single space
  unspace :: String -> String
  unspace str = go [] str
    where
      go acc []  = acc
      go acc [x] = acc ++ [x]
      go acc (' ':' ':xs) = go acc (' ':xs)
      go acc (x:xs) = go (acc++[x]) xs
  
  -- ---------------------------------------------------------------------
  
  mkTestGhcName :: Int -> Maybe GHC.Module -> String -> GHC.Name
  mkTestGhcName u maybeMod name = n
    where
        un = GHC.mkUnique 'H' (u+1) -- H for HaRe :)
        n = case maybeMod of
                 Nothing -> GHC.localiseName $ GHC.mkSystemName un (GHC.mkVarOcc name)
                 Just modu -> GHC.mkExternalName un modu (GHC.mkVarOcc name) nullSrcSpan
  
  nullSrcSpan :: GHC.SrcSpan
  nullSrcSpan = GHC.UnhelpfulSpan $ GHC.mkFastString "HaRe nullSrcSpan"
  
  -- ---------------------------------------------------------------------
  
  parseToAnnotated :: (Show a, Annotate ast)
                   => GHC.DynFlags
                   -> FilePath
                   -> (GHC.DynFlags -> FilePath -> String -> Either a (Anns, GHC.Located ast))
                   -> String
                   -> (GHC.Located ast, Anns)
  parseToAnnotated df fp parser src = (ast,anns)
    where
      (anns, ast) = case (parser df fp src) of
                              Right xs -> xs
                              Left err -> error (show err)
  
  -- ---------------------------------------------------------------------
  
  parseDeclToAnnotated ::
                      GHC.DynFlags
                   -> FilePath
                   -- -> (GHC.DynFlags -> FilePath -> String -> Either a (Anns, GHC.Located ast))
                   -> String
                   -> (GHC.LHsDecl GHC.RdrName, Anns)
  parseDeclToAnnotated df fp src = (ast,anns)
    where
      (anns, ast) = case (parseDecl df fp src) of
                              Right xs -> xs
                              Left err -> error (show err)
  
  -- ---------------------------------------------------------------------
  
  ss2span :: GHC.SrcSpan -> (Pos,Pos)
  ss2span ss = (ss2pos ss,ss2posEnd ss)
  
  -- ---------------------------------------------------------------------
  
  -- | call ghc-excactprint hsDecls in a Transform context
  getHsDecls :: (HasDecls t) => t -> [GHC.LHsDecl GHC.RdrName]
  getHsDecls t = decls
    where
      -- runTransform :: Anns -> Transform a -> (a, (Anns, Int), [String])
      (decls,_,_) = runTransform mempty (hsDecls t)
  -- ---------------------------------------------------------------------
  
  showNameMap :: NameMap -> String
  showNameMap  nm = GHC.showSDocDebug GHC.unsafeGlobalDynFlags doc
      where
        doc = GHC.text "NameMap" GHC.<+> GHC.vcat (map one $ Map.toList nm)
        -- one (s,n) = GHC.parens $ GHC.text (showGhc (s,n,GHC.nameUnique n)) GHC.<+> GHC.ppr n
        one (s,n) = GHC.parens $ GHC.hsep [GHC.ppr s, GHC.comma, GHC.ppr n]
  
  -- ---------------------------------------------------------------------
  -- EOF
  