{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-}

module DebuggerImpl where

import GHC hiding (resume, back, forward)
import qualified GHC (resume, back, forward)
import qualified InteractiveEval
import GHC.Paths ( libdir )
import DynFlags
import GhcMonad (liftIO)

import ParserMonad (parse)
import CommandParser (debugCommand, DebugCommand(..))
import CmdArgsParser (cmdArgument, Argument(..))
import DebuggerMonad

import Network.Socket
import Network.BSD

import System.IO
import System.Environment (getArgs)
import Control.Monad (mplus, liftM)
import Data.List (partition, sortBy)
import BreakArray
import Data.Array
import Data.Function (on)
import SrcLoc (realSrcSpanEnd)

import Data.Maybe
import DebuggerUtils

import Debugger ()

import PprTyThing

import GHC.Exts()

---- || Debugger runner || --------------------------------------------------------------------------

tryRun :: DebuggerMonad (Result, Bool) -> DebuggerMonad (Result, Bool)
tryRun func = func `catch`
    (\ex -> return ([
            ("info", ConsStr "exception"),
            ("message", ConsStr $ show ex)
        ], False))


-- |Runs Ghc program with default settings
defaultRunGhc :: DebuggerMonad a -> IO ()
defaultRunGhc program = defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhc (Just libdir) $
    startDebugger (do
        handleArguments
        st <- getDebugState
        modulePath <- do
            case (mainFile st) of
                Just path -> return path
                Nothing   -> error "Main module not specified"
        setupContext modulePath "Main"
        initDebugOutput
        initInterpBuffering
        turnOffBuffering -- turns off buffering of stdout and stderr of program
        program
        return ()
    ) initState

-- |Setup needed flags before running debug program
setupContext :: String -> String -> DebuggerMonad ()
setupContext pathToModule nameOfModule = do
    dflags <- getSessionDynFlags
    setSessionDynFlags $ dflags { hscTarget = HscInterpreted
                                , ghcLink   = LinkInMemory
                                , ghcMode   = CompManager
                                }
    setTargets =<< sequence [guessTarget pathToModule Nothing]
    GHC.load LoadAllTargets
    setContext [IIModule $ mkModuleName nameOfModule]
    return ()

handleArguments :: DebuggerMonad ()
handleArguments = do
    args <- liftIO getArgs
    mapM_ handle' args where
        handle' x = do
            let arg = fst $ head $ parse cmdArgument x
            case arg of
                Main m    -> modifyDebugState $ \st -> st{mainFile = Just m}
                Import path -> do
                    dflags <- getSessionDynFlags
                    setSessionDynFlags dflags{importPaths = path : importPaths dflags}
                    return ()
                SetPort p -> modifyDebugState $ \st -> st{port = Just p}
                ExposePkg pkg -> do
                    dflags <- getSessionDynFlags
                    setSessionDynFlags dflags{packageFlags = ExposePackage pkg : packageFlags dflags}
                    return ()
                CmdArgsParser.Unknown s -> printJSON [
                        ("info", ConsStr "warning"),
                        ("message", ConsStr $ "unknown argument: " ++ s)
                    ]

initDebugOutput :: DebuggerMonad ()
initDebugOutput = do
    st <- getDebugState
    let m_port = port st
    case m_port of
        Nothing -> printJSON [
                ("info", ConsStr "warning"),
                ("message", ConsStr "Port for debug stream was not set (using stdout); use command line argument -p<port> to set it")
            ]
        Just port' -> do
            let host = "localhost"
            sock <- liftIO $ socket AF_INET Stream 0
            addrs <- liftIO $ liftM hostAddresses $ getHostByName host
            do {
                liftIO $ connect sock $ SockAddrInet (toEnum port') (head addrs);
                handle <- liftIO $ socketToHandle sock ReadWriteMode;
                modifyDebugState $ \st' -> st'{debugOutput = handle};
                printJSON [
                        ("info", ConsStr "connected to port"),
                        ("port", ConsInt port')
                    ];
            } `catch` (\ex -> printJSON [
                        ("info", ConsStr "exception"),
                        ("message", ConsStr $ show ex ++ "; using stdout for debug output")
                    ])

-- |In loop waits for commands and executes them
startCommandLine :: DebuggerMonad ()
startCommandLine = whileNot $ do
    command <- getCommand stdin `catch` (const $ return Exit)
    result <- tryRun (runCommand command)
    printJSON $ fst result
    return $ snd result

whileNot :: DebuggerMonad Bool -> DebuggerMonad ()
whileNot p = do
    x <- p
    if not x then whileNot p else return ()

-- |Translates line from input stream into DebugCommand
getCommand :: Handle -> DebuggerMonad DebugCommand
getCommand handle_ = do
    line <- liftIO $ hGetLine handle_
    return $ fst $ head $ parse debugCommand line

type Result = [(String, T)]

-- |Runs DebugCommand and returns True iff debug is finished
-- Inside commands there should not be any output to debug stream
runCommand :: DebugCommand -> DebuggerMonad (Result, Bool)
runCommand (SetBreakpoint modName line)   = notEnd $ setBreakpointLikeGHCiDo modName line
runCommand (SetBreakByIndex modName ind)  = notEnd $ doBreakindex modName ind
runCommand (RemoveBreakpoint modName ind) = notEnd $ deleteBreakpoint modName ind
runCommand (Trace command)                = doTrace command
runCommand Resume                         = doResume
runCommand StepInto                       = doStepInto
runCommand StepOver                       = doStepLocal
runCommand History                        = notEnd $ showHistory defaultHistSize
runCommand Back                           = notEnd $ back
runCommand Forward                        = notEnd $ forward
runCommand Exit                           = return ([], True)
runCommand (BreakList modName)            = notEnd $ showBreaks modName
runCommand (LineBreakList modName line)   = notEnd $ showBreaksForLine modName line
runCommand Help                           = printString fullHelpText >> return ([], False)
runCommand (SPrint name)                  = notEnd $ doSPrint name
runCommand (Force expr)                   = notEnd $ doForce expr
runCommand (ExprType expr)                = notEnd $ getExprType expr
runCommand (Evaluate force expr)          = notEnd $ evaluate force expr
runCommand (Set flag)                     = notEnd $ set flag
runCommand (Unset flag)                   = notEnd $ unset flag
runCommand BreakinfoCmd                   = notEnd $ doBreakinfo
runCommand _                              = return ([
                                                ("info", ConsStr "exception"),
                                                ("message", ConsStr "unknown command")
                                            ], False)

notEnd :: DebuggerMonad Result -> DebuggerMonad (Result, Bool)
notEnd obj = obj >>= (\x -> return (x, False))

-- | setBreakpoint version with selector just taking first of avaliable breakpoints
setBreakpointFirstOfAvailable :: String -> Int -> DebuggerMonad Result
setBreakpointFirstOfAvailable modName line = setBreakpoint modName line (Just . head)

-- | setBreakpoint version with selector choosing
-- |   - the leftmost complete subexpression on the specified line, or
-- |   - the leftmost subexpression starting on the specified line, or
-- |   - the rightmost subexpression enclosing the specified line
-- | This strategy is the same to one GHCi currently uses
setBreakpointLikeGHCiDo :: String -> Int -> DebuggerMonad Result
setBreakpointLikeGHCiDo modName line = setBreakpoint modName line selectOneOf
    where selectOneOf :: [(BreakIndex, SrcSpan)] -> Maybe (BreakIndex, SrcSpan)
          selectOneOf breaks_ = listToMaybe (sortBy (leftmost_largest `on` snd)  onelineBreaks) `mplus`
                                listToMaybe (sortBy (leftmost_smallest `on` snd) multilineBreaks) `mplus`
                                listToMaybe (sortBy (rightmost `on` snd) breaks_)
            where (onelineBreaks, multilineBreaks) = partition endEqLine breaksWithStartEqLine
                  endEqLine (_, RealSrcSpan r) = GHC.srcSpanEndLine r == line
                  endEqLine _ = False
                  breaksWithStartEqLine = [ br | br@(_, srcSpan) <- breaks_,
                                            case srcSpan of (RealSrcSpan r) -> GHC.srcSpanStartLine r == line; _ -> False ]

-- | finds all avaliable breakpoint for given line, then using selector takes one of them and activates it
-- | if no breaks are avaliable proper message is shown
setBreakpoint :: String -> Int -> ([(BreakIndex, SrcSpan)] -> Maybe (BreakIndex, SrcSpan)) -> DebuggerMonad Result
setBreakpoint modName line selector = do
    breaksForLine <- findBreaksForLine modName line
    case breaksForLine of 
        []           -> return [
                                ("info", ConsStr "breakpoint was not set"),
                                ("add_info", ConsStr "not allowed here")
                            ]
        bbs@(b : bs) -> do
            let mbBreakToSet = if (null bs) then Just b else selector bbs
            case mbBreakToSet of
                Just (breakIndex, srcSpan) -> do
                    res <- changeBreakFlagInModBreaks modName breakIndex True
--                    let msg = if res then "# Breakpoint (index = "++ show breakIndex ++") was set here:\n" ++ show srcSpan
--                              else "# Breakpoint was not set: setBreakOn returned False"
                    if res
                        then return [
                                ("info", ConsStr "breakpoint was set"),
                                ("index", ConsInt $ breakIndex),
                                ("src_span", srcSpanAsJSON srcSpan)
                            ]
                        else return [
                                ("info", ConsStr "breakpoint was not set"),
                                ("add_info", ConsStr "selector returned Nothing")
                            ]
                Nothing -> return [
                                ("info", ConsStr "breakpoint was not set"),
                                ("add_info", ConsStr "selector returned Nothing")
                            ]

-- | sets breakpoint by index
doBreakindex :: String -> Int -> DebuggerMonad Result
doBreakindex modName breakIndex = do
    modBreaks <- getModBreaks modName
    let locs = modBreaks_locs modBreaks
    let (start, end) = bounds locs
    case start <= breakIndex && breakIndex <= end of
        True -> do
            res <- changeBreakFlagInModBreaks modName breakIndex True
            if res
                then return [
                        ("info", ConsStr "breakpoint was set"),
                        ("index", ConsInt $ breakIndex),
                        ("src_span", srcSpanAsJSON $ locs ! breakIndex)
                            ]
                else return [
                        ("info", ConsStr "breakpoint was not set"),
                        ("add_info", ConsStr "setBreakFlag returned False")
                            ]
        False -> do
            return [ ("info", ConsStr "breakpoint was not set"), ("add_info", ConsStr "wrong index") ]

-- | returns list of (BreakIndex, SrcSpan) for moduleName, where each element satisfies: srcSpanStartLine == line
-- | todo: this function is very suboptimal, it is temporary decition
findBreaksForLine :: String -> Int -> DebuggerMonad [(BreakIndex, SrcSpan)]
findBreaksForLine modName line = filterBreaksLocations modName predLineEq
    where predLineEq = \(_, srcSpan) -> case srcSpan of UnhelpfulSpan _ -> False
                                                        RealSrcSpan r   -> line == (srcSpanStartLine r)

-- | returns list of (BreakIndex, SrcSpan) for moduleName, where each element satisfies: srcSpanStartLine <= line <= srcSpanEndLine
-- | todo: this function is very suboptimal, it is temporary decition
findBreaksContainingLine :: String -> Int -> DebuggerMonad [(BreakIndex, SrcSpan)]
findBreaksContainingLine modName line = filterBreaksLocations modName predLineEq
    where predLineEq = \(_, srcSpan) -> case srcSpan of UnhelpfulSpan _ -> False
                                                        RealSrcSpan r   -> (srcSpanStartLine r) <= line && line <= (srcSpanEndLine r)

-- | returns list of (BreakIndex, SrcSpan) for moduleName, where each element satisfies predicate
filterBreaksLocations :: String -> ((BreakIndex, SrcSpan) -> Bool) -> DebuggerMonad [(BreakIndex, SrcSpan)]
filterBreaksLocations modName predicate = do
    modBreaks <- getModBreaks modName
    let breaksLocations = assocs $ modBreaks_locs modBreaks
    return $ filter predicate breaksLocations

-- | get ModBreaks for given modulename
getModBreaks :: String -> DebuggerMonad ModBreaks
getModBreaks modName = do
    module_ <- GHC.lookupModule (mkModuleName modName) Nothing
    Just modInfo <- getModuleInfo module_
    return $ modInfoModBreaks modInfo

-- | modBreaks_flags of ModBreaks contains info about set and unset breakpoints for specified module
-- | This function just set or unset given flag
changeBreakFlagInModBreaks :: String -> Int -> Bool -> DebuggerMonad Bool
changeBreakFlagInModBreaks modName flagIndex flagValue = do
    modBreaks <- getModBreaks modName
    let breaksFlags = modBreaks_flags modBreaks
    liftIO $ setBreakFlag breaksFlags flagIndex flagValue

setBreakFlag :: BreakArray -> Int -> Bool -> IO Bool
setBreakFlag bArr ind flag | flag      = setBreakOn bArr ind
                           | otherwise = setBreakOff bArr ind

-- | ':delete <module name> <break index>' command
deleteBreakpoint ::  String -> Int -> DebuggerMonad Result
deleteBreakpoint modName breakIndex = do
    res <- changeBreakFlagInModBreaks modName breakIndex False
    if res
        then return [
                ("info", ConsStr "breakpoint was removed"),
                ("index", ConsInt breakIndex)
            ]
        else return [
                ("info", ConsStr "breakpoint was not removed"),
                ("add_info", ConsStr "incorrect index")
            ]

-- | ':trace' command
doTrace :: String -> DebuggerMonad (Result, Bool)
doTrace []   = doContinue (const True) GHC.RunAndLogSteps
doTrace expr = do
    runResult <- GHC.runStmt expr GHC.RunAndLogSteps `catch`
        (\ex -> (liftIO $ hPutStrLn stderr $ show ex) >> (return $ GHC.RunOk []))
    afterRunStmt (const True) runResult

doContinue :: (SrcSpan -> Bool) -> SingleStep -> DebuggerMonad (Result, Bool)
doContinue canLogSpan step = do
    runResult <- GHC.resume canLogSpan step
    afterRunStmt canLogSpan runResult

afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> DebuggerMonad (Result, Bool)
afterRunStmt canLogSpan (GHC.RunException e) = do
    liftIO $ hPutStrLn stderr (show e)
    afterRunStmt canLogSpan (GHC.RunOk [])
afterRunStmt canLogSpan runResult = do
    -- flushInterpBuffers -- it's not needed to flush because buffering is disabled
    resumes <- GHC.getResumeContext
    case runResult of
        GHC.RunOk names -> do
            names_str <- mapM showOutputable names
            let res = [
                        ("info", ConsStr "finished"),
                        ("names", ConsArr $ map ConsStr names_str)
                    ]
            return (res, False)
        GHC.RunBreak _ names mbBreakInfo
            | isNothing  mbBreakInfo || canLogSpan (GHC.resumeSpan $ head resumes) -> do
                let srcSpan = GHC.resumeSpan $ head resumes
                    apStack = InteractiveEval.resumeApStack $ head resumes
                --liftIO $ c_print_ap_stack (Ptr (unsafeCoerce# apStack))
                functionName <- getFunctionName mbBreakInfo
                vars <- getNamesInfo names
                let res = [
                            ("info", ConsStr "paused"),
                            ("src_span", srcSpanAsJSON srcSpan),
                            ("function", ConsStr functionName),
                            ("vars", vars)
                        ]
                return (res, False)
            | otherwise -> do
                nextRunResult <- GHC.resume canLogSpan GHC.SingleStep
                afterRunStmt canLogSpan nextRunResult
        _ -> return ([
                ("info", ConsStr "warning"),
                ("message", ConsStr "Unknown RunResult")
            ], False)
        where
            getFunctionName :: Maybe BreakInfo -> DebuggerMonad String
            getFunctionName Nothing = return ""
            getFunctionName (Just breakInfo) = do
                Just modInfo <- getModuleInfo $ breakInfo_module breakInfo
                let modBreaks = modInfoModBreaks modInfo
                let allDecls = modBreaks_decls $ modBreaks
                return $ last (allDecls ! (breakInfo_number breakInfo))

-- | ':continue' command
doResume :: DebuggerMonad (Result, Bool)
doResume = doContinue (const True) GHC.RunToCompletion

-- |':step [<expr>]' command - general step command
doStepGeneral :: String -> DebuggerMonad (Result, Bool)
doStepGeneral []   = doContinue (const True) GHC.SingleStep
doStepGeneral _ = return ([
         ("info", ConsStr "exception"),
         ("message", ConsStr "not implemented yet")
     ], False)

-- |':step' command
doStepInto :: DebuggerMonad (Result, Bool)
doStepInto = doStepGeneral []

-- | ':steplocal' command
doStepLocal :: DebuggerMonad (Result, Bool)
doStepLocal = do
    mbSrcSpan <- getCurrentBreakSpan
    case mbSrcSpan of
        Nothing  -> doStepInto
        Just srcSpan -> do
            Just module_ <- getCurrentBreakModule
            mbCurrentToplevelDecl <- enclosingSpan module_ srcSpan
            case mbCurrentToplevelDecl of
                Nothing -> return ([
                        ("info", ConsStr "warning"),
                        ("message", ConsStr "steplocal was not performed: enclosingSpan returned Nothing")
                    ], False)
                Just currentToplevelDecl -> doContinue (`isSubspanOf` currentToplevelDecl) GHC.SingleStep

-- | Returns the largest SrcSpan containing the given one or Nothing
enclosingSpan :: Module -> SrcSpan -> DebuggerMonad (Maybe SrcSpan)
enclosingSpan _ (UnhelpfulSpan _) = return Nothing
enclosingSpan module_ (RealSrcSpan rSrcSpan) = do
    let line = srcSpanStartLine rSrcSpan
    breaks_ <- findBreaksContainingLine (moduleNameString $ moduleName module_) line
    case breaks_ of
        [] -> return Nothing
        bs -> return . Just . head . sortBy leftmost_largest $ enclosingSpans bs
        where
            enclosingSpans bs = [ s | (_, s) <- bs, case s of UnhelpfulSpan _ -> False
                                                              RealSrcSpan r   -> realSrcSpanEnd r >= realSrcSpanEnd rSrcSpan ]


getCurrentBreakSpan :: DebuggerMonad (Maybe SrcSpan)
getCurrentBreakSpan = do
  resumes <- GHC.getResumeContext
  case resumes of
    [] -> return Nothing
    (r:_) -> do
        let ix = GHC.resumeHistoryIx r
        if ix == 0
           then return (Just (GHC.resumeSpan r))
           else do
                let hist = GHC.resumeHistory r !! (ix-1)
                pan <- GHC.getHistorySpan hist
                return (Just pan)


getNamesInfo :: [Name] -> DebuggerMonad T
getNamesInfo names = do
    let namesSorted = sortBy compareNames names
    alltythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
    let tythings = [AnId i | AnId i <- alltythings]
    names' <- mapM getThingName tythings
    types <- mapM getThingType tythings
    values <- mapM getThingValue tythings

    return $ ConsArr $ map (\(n, t, v) -> ConsObj [
            ("name", ConsStr n),
            ("type", ConsStr t),
            ("value", ConsStr v)
        ]) (zip3 names' types values)
        where
            getThingName :: TyThing -> DebuggerMonad (String)
            getThingName = showOutputable . getName

            getThingType :: TyThing -> DebuggerMonad (String)
            getThingType (AnId id') = do
                showSDoc $ pprTypeForUser False (GHC.idType id')
            getThingType _ = fail "Shouldn't be here"

            getThingValue :: TyThing -> DebuggerMonad (String)
            getThingValue (AnId id') = do
                term <- GHC.obtainTermFromId 100 False id'
                showOutputable term
            getThingValue _ = fail "Shouldn't be here"


getCurrentBreakModule :: DebuggerMonad (Maybe Module)
getCurrentBreakModule = do
    mbBreakInfo <- getCurrentBreakInfo
    return $ GHC.breakInfo_module `liftM` mbBreakInfo


getCurrentBreakInfo :: DebuggerMonad (Maybe BreakInfo)
getCurrentBreakInfo = do
    resumes <- GHC.getResumeContext
    case resumes of
        [] -> return Nothing
        (r:_) -> do
            let ix = GHC.resumeHistoryIx r
            if ix == 0
               then return $ GHC.resumeBreakInfo r
               else do
                    let hist = GHC.resumeHistory r !! (ix-1)
                    return $ Just $ GHC.historyBreakInfo hist

-- | ':breakinfo' debugCommand
doBreakinfo :: DebuggerMonad Result
doBreakinfo = do
    mbBreakInfo <- getCurrentBreakInfo
    case mbBreakInfo of
        Nothing        -> printString "# No break info available"
        Just breakInfo -> printOutputable breakInfo
    return []

-- | ':history' command
showHistory :: Int -> DebuggerMonad Result
showHistory num = do
    resumes <- GHC.getResumeContext
    case resumes of
        [] -> return [("info", ConsStr "not stopped at breakpoint")]
        (r:_) -> do
            let hist = resumeHistory r
                (took, rest) = splitAt num hist
            spans' <- mapM (GHC.getHistorySpan) took
            let idx = map (0-) [(1::Int) ..]
                -- todo: get full path of the file
                lines' = map (\(i, s, h) -> ConsObj [
                        ("index", ConsInt i),
                        ("function", (ConsStr . head . GHC.historyEnclosingDecls) h),
                        ("src_span", srcSpanAsJSON s)
                    ]) (zip3 idx spans' hist)
            return [
                    ("info", ConsStr "got history"),
                    ("history", ConsArr lines'),
                    ("end_reached", ConsBool (null rest))
                ]

-- | ':breaklist <mod>' command
showBreaks :: String -> DebuggerMonad Result
showBreaks modName = do
    modBreaks <- getModBreaks modName
    let locs = assocs $ modBreaks_locs $ modBreaks
    return [
            ("info", ConsStr "break list"),
            ("breaks", ConsArr $ map (\(i, e) -> ConsObj [
                    ("index", ConsInt i),
                    ("src_span", srcSpanAsJSON e)
                ]) locs)
        ]

-- | ':breaklist <mod> <line>' command
showBreaksForLine :: String -> Int -> DebuggerMonad Result
showBreaksForLine modName line = do
    breaksInfo <- findBreaksForLine modName line
    return [
            ("info", ConsStr $ "break list for line"),
            ("line", ConsStr $ show line),
            ("breaks",
             ConsArr $ map (\(i, e) -> ConsObj [("index", ConsInt i), ("src_span", srcSpanAsJSON e)]) breaksInfo)
           ]

-- | ':sprint' and ':force' commands
doSPrint, doForce :: String -> DebuggerMonad Result
doSPrint = evaluate False
doForce  = evaluate True

getExprType :: String -> DebuggerMonad Result
getExprType expr = do
    ty <- GHC.exprType expr
    doc <- showSDoc $ pprTypeForUser False ty
    return [
            ("info", ConsStr "expression type"),
            ("type", ConsStr doc)
        ]

-- | ":eval"
evaluate :: Bool -> String -> DebuggerMonad Result
evaluate force str = do
    -- it seems that __evalResult is not stored after evaluating, so it is safe to do such binding
    RunOk [name] <- GHC.runStmt ("let __evalResult = " ++ str) GHC.RunToCompletion
    Just (AnId id') <- GHC.lookupName name
    type' <- showSDoc $ pprTypeForUser False (GHC.idType id')
    term <- GHC.obtainTermFromId 100 force id'
    value <- showOutputable term
    return [
            ("info", ConsStr "evaluated"),
            ("type", ConsStr type'),
            ("value", ConsStr value)
        ]

-- | ":back"
back :: DebuggerMonad Result
back = do
    (names, _, pan) <- GHC.back
    names_str <- mapM showOutputable names
    evs <- mapM (evaluate False) names_str
    return [
            ("info", ConsStr "stepped back"),
            ("src_span", srcSpanAsJSON pan),
            ("vars", ConsArr $ map (\(name, [_, (_, ConsStr ty), (_, ConsStr val)]) -> ConsObj [
                    ("name", ConsStr name),
                    ("type", ConsStr ty),
                    ("value", ConsStr val)
                ]) (zip names_str evs))
        ]

-- | ":forward"
forward :: DebuggerMonad Result
forward = do
    (names, ix, pan) <- GHC.forward
    names_str <- mapM showOutputable names
    evs <- mapM (evaluate False) names_str
    return [
            ("info", ConsStr "stepped forward"),
            ("src_span", srcSpanAsJSON pan),
            ("vars", ConsArr $ map (\(name, [_, (_, ConsStr ty), (_, ConsStr val)]) -> ConsObj [
                    ("name", ConsStr name),
                    ("type", ConsStr ty),
                    ("value", ConsStr val)
                ]) (zip names_str evs)),
            ("hist_top", ConsBool (ix == 0))
        ]

set :: String -> DebuggerMonad Result
set flag = do
    case flag of
        "-fbreak-on-error" -> do
            dflags <- GHC.getSessionDynFlags
            let dflags' = DynFlags.dopt_set dflags DynFlags.Opt_BreakOnError
                dflags'' = DynFlags.dopt_unset dflags' DynFlags.Opt_BreakOnException
            GHC.setSessionDynFlags dflags''
            return [("info", ConsStr "break set")]
        "-fbreak-on-exception" -> do
            dflags <- GHC.getSessionDynFlags
            let dflags' = DynFlags.dopt_set dflags DynFlags.Opt_BreakOnException
                dflags'' = DynFlags.dopt_unset dflags' DynFlags.Opt_BreakOnError
            GHC.setSessionDynFlags dflags''
            return [("info", ConsStr "break set")]
        _ -> return [("info", ConsStr "exception"), ("message", ConsStr "Unknown \"set\" flag")]

unset :: String -> DebuggerMonad Result
unset flag = do
    case flag of
        "-fbreak-on-error" -> unsetBreak
        "-fbreak-on-exception" -> unsetBreak
        _ -> return [("info", ConsStr "exception"), ("message", ConsStr "Unknown \"unset\" flag")]
        where
            unsetBreak = do
                dflags <- GHC.getSessionDynFlags
                let dflags' = DynFlags.dopt_unset dflags DynFlags.Opt_BreakOnException
                    dflags'' = DynFlags.dopt_unset dflags' DynFlags.Opt_BreakOnError
                GHC.setSessionDynFlags dflags''
                return [("info", ConsStr "break unset")]


fullHelpText :: String
fullHelpText =
    " Commands available from the prompt:\n" ++
    " -- Commands for debugging:\n" ++
    "\n" ++
    "   :break <mod> <l>            set a breakpoint for module <mod> at the line <l>\n" ++
    "   :breakindex <mod> <i>       set a breakpoint with index <i> for module <mod>\n" ++
    "   :breaklist <mod>            show all available breakpoints (index and span) for module <mod>\n" ++
    "   :breaklist <mod> <l>        show all breakpoints containing line <l> for module <mod> and \n" ++
    "   :continue                   resume after a breakpoint\n" ++
    "   :delete <mod> <ind>         delete the breakpoint with index <ind> from module <mod>\n" ++
    "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
    "   :history                    after :trace, show the execution history\n" ++
    "   :sprint <name>              prints a value without forcing its computation\n" ++
    "   :step                       single-step after stopping at a breakpoint\n" ++
    "   :steplocal                  single-step within the current top-level binding\n" ++
    "   :trace <expr>               evaluate <expr> with tracing on (see :history)\n" ++
    "   :type <expr>                show the type of <expr>\n" ++
    "   :eval <int> <expr>          evaluates <expr> ((<int> > 0) => forced evaluation)\n" ++
    "   :set <flag>                 sets given DynFlag\n" ++
    "   :unset <flag>               unsets given DynFlag\n" ++
    "      available flags: -fbreak-on-error, -fbreak-on-exception\n" ++
    "   :breakinfo                  pretty printing for current BreakInfo\n" ++
    "   :q                          exit debugger\n"

---- || Hardcoded parameters (temporary for testing) || -----------------

-- |Default history size
defaultHistSize :: Int
defaultHistSize = 20


---- || Utils || -------------------------------------------------------

-- | Shows info from ModBreaks for given moduleName. It is useful for debuging of our debuger = )
printAllBreaksInfo :: String -> DebuggerMonad ()
printAllBreaksInfo modName = do
    modBreaks <- getModBreaks modName
    -- modBreaks_flags - 0 if unset 1 if set
    printString "# modBreaks_flags:"
    liftIO $ showBreakArray $ modBreaks_flags $ modBreaks
    -- modBreaks_locs - breakpoint index and SrcSpan
    printString "# modBreaks_locs:"
    mapM (\(i, e) -> printString (show i ++ " : " ++ show e)) $ assocs $ modBreaks_locs $ modBreaks
    -- modBreaks_decls - An array giving the names of the declarations enclosing each breakpoint
    printString "# modBreaks_decls:"
    mapM (\(i, ds) -> printString (show i ++ " : " ++ show ds)) $ assocs $ modBreaks_decls $ modBreaks
    return ()

-- | parse and execute commands in list (to auto tests)
-- | exapmle: main = defaultRunGhc $ execCommands [":trace main", ":q"] - load default module, make trace and exit
execCommands :: [String] -> DebuggerMonad ()
execCommands []       = return ()
execCommands (c : cs) = do
    result <- tryRun (runCommand $ fst $ head $ parse debugCommand c)
    printJSON $ fst result
    execCommands cs