{-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.LogRef
-- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie
-- License     :  GNU-GPL
--
-- Maintainer  :  <maintainer at leksah.org>
-- Stability   :  provisional
-- Portability :  portable
--
--
-- |
--
---------------------------------------------------------------------------------


module IDE.LogRef (
    nextError
,   previousError
,   nextBreakpoint
,   previousBreakpoint
,   markLogRefs
,   unmarkLogRefs
,   defaultLineLogger
,   defaultLineLogger'
,   logOutputLines
,   logOutputLines_
,   logOutputLinesDefault_
,   logOutput
,   logOutputDefault
,   logOutputPane
,   logOutputForBuild
,   logOutputForBreakpoints
,   logOutputForSetBreakpoint
,   logOutputForSetBreakpointDefault
,   logOutputForLiveContext
,   logOutputForLiveContextDefault
,   logOutputForHistoricContext
,   logOutputForHistoricContextDefault
,   selectRef
,   setBreakpointList
,   showSourceSpan
,   srcSpanParser
) where

import Graphics.UI.Gtk
import Control.Monad.Reader
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec hiding(Parser)
import qualified Text.ParserCombinators.Parsec.Token as P

import IDE.Core.State
import IDE.TextEditor
import IDE.Pane.SourceBuffer
import qualified IDE.Pane.Log as Log
import IDE.Utils.Tool
import System.FilePath (equalFilePath)
import Data.List (partition, stripPrefix, elemIndex, isPrefixOf)
import Data.Maybe (catMaybes, isJust)
import System.Exit (ExitCode(..))
import System.Log.Logger (debugM)
import IDE.Utils.FileUtils(myCanonicalizePath)
import IDE.Pane.Log (getDefaultLogLaunch, IDELog(..), getLog)
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Conduit ((=$))
import IDE.Pane.WebKit.Output(setOutput)
import Data.IORef (atomicModifyIORef, IORef, readIORef)
import Data.Text (Text)
import Control.Applicative ((<$>))
import qualified Data.Text as T
       (length, stripPrefix, isPrefixOf, unpack, unlines, pack, null)
import Data.Monoid ((<>))
import qualified Data.Set as S (notMember, member, insert, empty)
import Data.Set (Set)
import System.FilePath.Windows ((</>))

showSourceSpan :: LogRef -> Text
showSourceSpan = T.pack . displaySrcSpan . logRefSrcSpan

selectRef :: Maybe LogRef -> IDEAction
selectRef (Just ref) = do
    mbBuf         <- selectSourceBuf (logRefFullFilePath ref)
    case mbBuf of
        Just buf  -> markRefInSourceBuf buf ref True
        Nothing   -> liftIO . void $ debugM "leksah" "no buf"
    log :: Log.IDELog <- Log.getLog
    maybe (return ()) (Log.markErrorInLog log) (logLines ref)
selectRef Nothing = return ()

forOpenLogRefs :: (LogRef -> IDEBuffer -> IDEAction) -> IDEAction
forOpenLogRefs f = do
    logRefs <- readIDE allLogRefs
    allBufs <- allBuffers
    forM_ logRefs $ \ref -> do
        let fp = logRefFullFilePath ref
        fpc <- liftIO $ myCanonicalizePath fp
        forM_ (filter (\buf -> case fileName buf of
                Just fn -> equalFilePath fpc fn
                Nothing -> False) allBufs) (f ref)

markLogRefs :: IDEAction
markLogRefs =
    forOpenLogRefs $ \logRef buf -> markRefInSourceBuf buf logRef False

unmarkLogRefs :: IDEAction
unmarkLogRefs =
    forOpenLogRefs $ \logRef (IDEBuffer {sourceView = sv}) -> do
            buf     <-  getBuffer sv
            removeTagByName buf (T.pack $ show (logRefType logRef))

setBreakpointList :: [LogRef] -> IDEAction
setBreakpointList breaks = do
    ideR <- ask
    unmarkLogRefs
    errs <- readIDE errorRefs
    contexts <- readIDE contextRefs
    modifyIDE_ (\ide -> ide{allLogRefs = errs ++ breaks ++ contexts})
    setCurrentBreak Nothing
    markLogRefs
    triggerEventIDE BreakpointChanged
    return ()

addLogRefs :: [LogRef] -> IDEAction
addLogRefs refs = do
    ideR <- ask
    unmarkLogRefs
    modifyIDE_ (\ide -> ide{allLogRefs = allLogRefs ide ++ refs})
    setCurrentError Nothing
    markLogRefs
    triggerEventIDE (ErrorChanged False)
    triggerEventIDE BreakpointChanged
    triggerEventIDE TraceChanged
    return ()

next :: (IDE -> [LogRef])
     -> (IDE -> Maybe LogRef)
     -> (Maybe LogRef -> IDEAction)
     -> IDEAction
next all current set = do
    all <- readIDE all
    current <- readIDE current
    let isCurrent = (== current) . Just
    case dropWhile isCurrent (dropWhile (not . isCurrent) all) <> all of
        (n:_) -> do
            set (Just n)
            selectRef (Just n)
        _ -> return ()

nextError :: IDEAction
nextError = next errorRefs currentError setCurrentError

previousError :: IDEAction
previousError = next (reverse . errorRefs) currentError setCurrentError

nextBreakpoint :: IDEAction
nextBreakpoint = next breakpointRefs currentBreak setCurrentBreak

previousBreakpoint :: IDEAction
previousBreakpoint = next (reverse . breakpointRefs) currentBreak setCurrentBreak

nextContext :: IDEAction
nextContext = next contextRefs currentContext setCurrentContext

previousContext :: IDEAction
previousContext = next (reverse . contextRefs) currentContext setCurrentContext

lastContext :: IDEAction
lastContext = do
    contexts <- readIDE contextRefs
    currentContext <- readIDE currentContext
    case reverse contexts of
        (l:_) -> do
            setCurrentContext $ Just l
            selectRef $ Just l
        _ -> return ()

fixColumn c = max 0 (c - 1)

srcPathParser :: CharParser () FilePath
srcPathParser = try (do
        symbol "dist/build/tmp-" -- Support for cabal haddock
        many digit
        char '/'
        many (noneOf ":"))
    <|> many (noneOf ":")

srcSpanParser :: CharParser () SrcSpan
srcSpanParser = try (do
        filePath <- srcPathParser
        char ':'
        char '('
        beginLine <- int
        char ','
        beginCol <- int
        char ')'
        char '-'
        char '('
        endLine <- int
        char ','
        endCol <- int
        char ')'
        return $ SrcSpan filePath beginLine (fixColumn beginCol) endLine (fixColumn endCol))
    <|> try (do
        filePath <- srcPathParser
        char ':'
        line <- int
        char ':'
        beginCol <- int
        char '-'
        endCol <- int
        return $ SrcSpan filePath line (fixColumn beginCol) line (fixColumn endCol))
    <|> try (do
        filePath <- srcPathParser
        char ':'
        line <- int
        char ':'
        col <- int
        return $ SrcSpan filePath line (fixColumn col) line (fixColumn col))
    <?> "srcSpanParser"

data BuildOutput = BuildProgress Int Int FilePath
                 | DocTestFailure SrcSpan Text

buildOutputParser :: CharParser () BuildOutput
buildOutputParser = try (do
        char '['
        n <- int
        whiteSpace
        symbol "of"
        whiteSpace
        total <- int
        char ']'
        whiteSpace
        symbol "Compiling"
        many (noneOf "(")
        char '('
        whiteSpace
        file <- many (noneOf ",")
        char ','
        many anyChar
        return $ BuildProgress n total file)
    <|> try (do
        symbol "###"
        whiteSpace
        symbol "Failure"
        whiteSpace
        symbol "in"
        whiteSpace
        file <- many (noneOf ":")
        char ':'
        line <- int
        char ':'
        whiteSpace
        text <- T.pack <$> many anyChar
        return $ DocTestFailure (SrcSpan file line 7 line (T.length text - 7)) $ "Failure in " <> text)
    <?> "buildOutputParser"

data BuildError =   BuildLine
                |   EmptyLine
                |   ErrorLine SrcSpan LogRefType Text
                |   WarningLine Text
                |   OtherLine Text

buildErrorParser :: CharParser () BuildError
buildErrorParser = try (do
        char '['
        int
        symbol "of"
        int
        char ']'
        many anyChar
        return BuildLine)
    <|> try (do
        whiteSpace
        span <- srcSpanParser
        char ':'
        whiteSpace
        refType <- try (do
                symbol "Warning:"
                return WarningRef)
            <|> return ErrorRef
        text <- T.pack <$> many anyChar
        return (ErrorLine span refType text))
    <|> try (do
        whiteSpace
        eof
        return EmptyLine)
    <|> try (do
        whiteSpace
        symbol "Warning:"
        text <- T.pack <$> many anyChar
        return (WarningLine ("Warning:" <> text)))
    <|> try (do
        text <- T.pack <$> many anyChar
        eof
        return (OtherLine text))
    <?> "buildLineParser"

data BreakpointDescription = BreakpointDescription Int SrcSpan

breaksLineParser :: CharParser () BreakpointDescription
breaksLineParser = try (do
        char '['
        n <- int
        char ']'
        whiteSpace
        many (noneOf " ")
        whiteSpace
        span <- srcSpanParser
        return (BreakpointDescription n span))
    <?> "breaksLineParser"

setBreakpointLineParser :: CharParser () BreakpointDescription
setBreakpointLineParser = try (do
        symbol "Breakpoint"
        whiteSpace
        n <- int
        whiteSpace
        symbol "activated"
        whiteSpace
        symbol "at"
        whiteSpace
        span <- srcSpanParser
        return (BreakpointDescription n span))
    <?> "setBreakpointLineParser"

lexer = P.makeTokenParser emptyDef
lexeme = P.lexeme lexer
whiteSpace = P.whiteSpace lexer
hexadecimal = P.hexadecimal lexer
symbol = P.symbol lexer
identifier = P.identifier lexer
colon = P.colon lexer
int = fromInteger <$> P.integer lexer

defaultLineLogger :: IDELog -> LogLaunch -> ToolOutput -> IDEM Int
defaultLineLogger log logLaunch out = liftIO $ defaultLineLogger' log logLaunch out

defaultLineLogger' :: IDELog -> LogLaunch -> ToolOutput -> IO Int
defaultLineLogger' log logLaunch out =
    case out of
        ToolInput  line            -> appendLog' (line <> "\n") InputTag
        ToolOutput line            -> appendLog' (line <> "\n") LogTag
        ToolError  line            -> appendLog' (line <> "\n") ErrorTag
        ToolPrompt line            -> do
            unless (T.null line) $ void (appendLog' (line <> "\n") LogTag)
            appendLog' (T.pack (concat (replicate 20 "- ")) <> "-\n") FrameTag
        ToolExit   ExitSuccess     -> appendLog' (T.pack (replicate 41 '-') <> "\n") FrameTag
        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (replicate 41 '=') <> "\n") FrameTag
        ToolExit   (ExitFailure n) -> appendLog' (T.pack (take 41 ("========== " ++ show n <> " " ++ repeat '=')) <> "\n") FrameTag
    where
        appendLog' = Log.appendLog log logLaunch

paneLineLogger :: IDELog -> LogLaunch -> ToolOutput -> IDEM (Maybe Text)
paneLineLogger log logLaunch out = liftIO $ paneLineLogger' log logLaunch out

paneLineLogger' :: IDELog -> LogLaunch -> ToolOutput -> IO (Maybe Text)
paneLineLogger' log logLaunch out =
    case out of
        ToolInput  line            -> appendLog' (line <> "\n") InputTag >> return Nothing
        ToolOutput line            -> appendLog' (line <> "\n") LogTag >> return (Just line)
        ToolError  line            -> appendLog' (line <> "\n") ErrorTag >> return Nothing
        ToolPrompt line            -> do
            unless (T.null line) $ void (appendLog' (line <> "\n") LogTag)
            appendLog' (T.pack (concat (replicate 20 "- ")) <> "-\n") FrameTag
            return Nothing
        ToolExit   ExitSuccess     -> appendLog' (T.pack (replicate 41 '-') <> "\n") FrameTag >> return Nothing
        ToolExit   (ExitFailure 1) -> appendLog' (T.pack (replicate 41 '=') <> "\n") FrameTag >> return Nothing
        ToolExit   (ExitFailure n) -> appendLog' (T.pack (take 41 ("========== " ++ show n ++ " " ++ repeat '=')) <> "\n") FrameTag >> return Nothing
    where
        appendLog' = Log.appendLog log logLaunch

logOutputLines :: LogLaunch -- ^ logLaunch
               -> (IDELog -> LogLaunch -> ToolOutput -> IDEM a)
               -> C.Sink ToolOutput IDEM [a]
logOutputLines logLaunch lineLogger = do
    log :: Log.IDELog <- lift $ postSyncIDE Log.getLog
    results <- CL.mapM (postSyncIDE . lineLogger log logLaunch) =$ CL.consume
    lift $ triggerEventIDE (StatusbarChanged [CompartmentState "", CompartmentBuild False])
    return results

logOutputLines_ :: LogLaunch
                -> (IDELog -> LogLaunch -> ToolOutput -> IDEM a)
                -> C.Sink ToolOutput IDEM ()
logOutputLines_ logLaunch lineLogger = do
    logOutputLines logLaunch lineLogger
    return ()

logOutputLinesDefault_ :: (IDELog -> LogLaunch -> ToolOutput -> IDEM a)
                       -> C.Sink ToolOutput IDEM ()
logOutputLinesDefault_ lineLogger = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    logOutputLines_  defaultLogLaunch lineLogger

logOutput :: LogLaunch
          -> C.Sink ToolOutput IDEM ()
logOutput logLaunch = do
    logOutputLines logLaunch defaultLineLogger
    return ()

logOutputDefault :: C.Sink ToolOutput IDEM ()
logOutputDefault = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    logOutput defaultLogLaunch

logOutputPane :: Text -> IORef [Text] -> C.Sink ToolOutput IDEM ()
logOutputPane command buffer = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    result <- catMaybes <$> logOutputLines defaultLogLaunch paneLineLogger
    unless (null result) $ do
        new <- liftIO . atomicModifyIORef buffer $ \x -> let new = x ++ result in (new, new)
        mbURI <- lift $ readIDE autoURI
        unless (isJust mbURI) . lift . postSyncIDE . setOutput command $ T.unlines new

data BuildOutputState = BuildOutputState { log           :: IDELog
                                         , inError       :: Bool
                                         , inDocTest     :: Bool
                                         , errs          :: [LogRef]
                                         , testFails     :: [LogRef]
                                         , filesCompiled :: Set FilePath
                                         }

-- Not quite a Monoid
initialState :: IDELog -> BuildOutputState
initialState log = BuildOutputState log False False [] [] S.empty

logOutputForBuild :: IDEPackage
                  -> Bool
                  -> Bool
                  -> C.Sink ToolOutput IDEM [LogRef]
logOutputForBuild package backgroundBuild jumpToWarnings = do
    liftIO $ debugM "leksah" "logOutputForBuild"
    log    <- lift getLog
    logLaunch <- lift Log.getDefaultLogLaunch
    BuildOutputState {..} <- CL.foldM (readAndShow logLaunch) $ initialState log
    ideR <- lift ask
    liftIO $ postGUISync $ reflectIDE (do
        allErrorLikeRefs <- readIDE errorRefs
        triggerEventIDE (Sensitivity [(SensitivityError,not (null allErrorLikeRefs))])
        let errorNum    =   length (filter isError errs)
        let warnNum     =   length errs - errorNum
        triggerEventIDE (StatusbarChanged [CompartmentState
            (T.pack $ show errorNum ++ " Errors, " ++ show warnNum ++ " Warnings"), CompartmentBuild False])
        return errs) ideR
  where
    readAndShow :: LogLaunch -> BuildOutputState -> ToolOutput -> IDEM BuildOutputState
    readAndShow logLaunch state@BuildOutputState {..} output = do
        ideR <- ask
        let logPrevious (previous:_) = reflectIDE (addLogRef False backgroundBuild previous) ideR
            logPrevious _ = return ()

        liftIO $ postGUISync $ case output of
            ToolError line -> do
                let parsed  =  parse buildErrorParser "" $ T.unpack line
                let nonErrorPrefixes = ["Linking ", "ar:", "ld:", "ld warning:"]
                tag <- case parsed of
                    Right BuildLine -> return InfoTag
                    Right (OtherLine text) | "Linking " `T.isPrefixOf` text ->
                        -- when backgroundBuild $ lift interruptProcess
                        return InfoTag
                    Right (OtherLine text) | any (`T.isPrefixOf` text) nonErrorPrefixes ->
                        return InfoTag
                    _ -> return ErrorTag
                lineNr <- Log.appendLog log logLaunch (line <> "\n") tag
                case (parsed, errs) of
                    (Left e,_) -> do
                        sysMessage Normal . T.pack $ show e
                        return state { inError = False }
                    (Right ne@(ErrorLine span refType str),_) -> do
                        let ref  = LogRef span package str Nothing (Just (lineNr,lineNr)) refType
                            root = logRefRootPath ref
                            file = logRefFilePath ref
                            fullFilePath = logRefFullFilePath ref
                        unless (fullFilePath `S.member` filesCompiled) $
                            reflectIDE (removeBuildLogRefs root file) ideR
                        when inError $ logPrevious errs
                        return state { inError = True
                                     , errs = ref:errs
                                     , filesCompiled = S.insert fullFilePath filesCompiled
                                     }
                    (Right (OtherLine str1), ref@(LogRef span rootPath str Nothing (Just (l1,l2)) refType):tl) ->
                        if inError
                            then return state { errs = LogRef span rootPath
                                                         (if T.null str then line else str <> "\n" <> line)
                                                         Nothing
                                                         (Just (l1, lineNr))
                                                         refType
                                                         : tl
                                              }
                            else return state
                    (Right (WarningLine str1),LogRef span rootPath str Nothing (Just (l1, l2)) isError : tl) ->
                        if inError
                            then return state { errs = LogRef span rootPath
                                                         (if T.null str then line else str <> "\n" <> line)
                                                         Nothing
                                                         (Just (l1, lineNr))
                                                         WarningRef
                                                         : tl
                                              }
                            else return state
                    _ -> do
                        when inError $ logPrevious errs
                        return state { inError = False }
            ToolOutput line ->
                case (parse buildOutputParser "" $ T.unpack line, inDocTest, testFails) of
                    (Right (BuildProgress n total file), _, _) -> do
                        logLn <- Log.appendLog log logLaunch (line <> "\n") LogTag
                        reflectIDE (triggerEventIDE (StatusbarChanged [CompartmentState
                            (T.pack $ "Compiling " ++ show n ++ " of " ++ show total), CompartmentBuild False])) ideR
                        let root = ipdBuildDir package
                            fullFilePath = root </> file
                        unless (fullFilePath `S.member` filesCompiled) $
                            reflectIDE (removeBuildLogRefs root file) ideR
                        when inDocTest $ logPrevious testFails
                        return state { inDocTest = False }
                    (Right (DocTestFailure span exp), _, _) -> do
                        logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag
                        when inDocTest $ logPrevious testFails
                        return state { inDocTest = True
                                     , testFails = LogRef span
                                            package
                                            exp
                                            Nothing (Just (logLn,logLn)) TestFailureRef : testFails
                                     }
                    (_, True, LogRef span rootPath str Nothing (Just (l1, l2)) refType : tl) -> do
                        logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag
                        return state { testFails = LogRef span
                                            rootPath
                                            (str <> "\n" <> line)
                                            Nothing (Just (l1,logLn)) TestFailureRef : tl
                                     }
                    _ -> do
                        Log.appendLog log logLaunch (line <> "\n") LogTag
                        when inDocTest $ logPrevious testFails
                        return state { inDocTest = False }
            ToolInput line -> do
                Log.appendLog log logLaunch (line <> "\n") InputTag
                return state
            ToolPrompt line -> do
                unless (T.null line) . void $ Log.appendLog log logLaunch (line <> "\n") LogTag
                when inError $ logPrevious errs
                when inDocTest $ logPrevious testFails
                let errorNum    =   length (filter isError errs)
                let warnNum     =   length errs - errorNum
                case errs of
                    [] -> defaultLineLogger' log logLaunch output
                    _ -> Log.appendLog log logLaunch (T.pack $ "- - - " ++ show errorNum ++ " errors - "
                                            ++ show warnNum ++ " warnings - - -\n") FrameTag
                return state { inError = False, inDocTest = False }
            ToolExit _ -> do
                let errorNum    =   length (filter isError errs)
                    warnNum     =   length errs - errorNum
                when inError $ logPrevious errs
                when inDocTest $ logPrevious testFails
                case (errs, testFails) of
                    ([], []) -> defaultLineLogger' log logLaunch output
                    _ -> Log.appendLog log logLaunch (T.pack $ "----- " ++ show errorNum ++ " errors -- "
                                            ++ show warnNum ++ " warnings -- "
                                            ++ show (length testFails) ++ " doctest failures -----\n") FrameTag
                return state { inError = False, inDocTest = False }

--logOutputLines :: Text -- ^ logLaunch
--               -> (LogLaunch -> ToolOutput -> IDEM a)
--               -> [ToolOutput]
--               -> IDEM [a]

logOutputForBreakpoints :: IDEPackage
                        -> LogLaunch           -- ^ loglaunch
                        -> C.Sink ToolOutput IDEM ()
logOutputForBreakpoints package logLaunch = do
    breaks <- logOutputLines logLaunch (\log logLaunch out ->
        case out of
            ToolOutput line -> do
                logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag
                case parse breaksLineParser "" $ T.unpack line of
                    Right (BreakpointDescription n span) ->
                        return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef
                    _ -> return Nothing
            _ -> do
                defaultLineLogger log logLaunch out
                return Nothing)
    lift $ setBreakpointList $ catMaybes breaks

logOutputForSetBreakpoint :: IDEPackage
                        -> LogLaunch           -- ^ loglaunch
                        -> C.Sink ToolOutput IDEM ()
logOutputForSetBreakpoint package logLaunch = do
    breaks <- logOutputLines logLaunch (\log logLaunch out ->
        case out of
            ToolOutput line -> do
                logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag
                case parse setBreakpointLineParser "" $ T.unpack line of
                    Right (BreakpointDescription n span) ->
                        return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef
                    _ -> return Nothing
            _ -> do
                defaultLineLogger log logLaunch out
                return Nothing)
    lift $ addLogRefs $ catMaybes breaks

logOutputForSetBreakpointDefault :: IDEPackage
                                 -> C.Sink ToolOutput IDEM ()
logOutputForSetBreakpointDefault package = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    logOutputForSetBreakpoint package defaultLogLaunch

logOutputForContext :: IDEPackage
                    -> LogLaunch                   -- ^ loglaunch
                    -> (Text -> [SrcSpan])
                    -> C.Sink ToolOutput IDEM ()
logOutputForContext package loglaunch getContexts = do
    refs <- catMaybes <$> logOutputLines loglaunch (\log logLaunch out ->
        case out of
            ToolOutput line -> do
                logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag
                let contexts = getContexts line
                if null contexts
                    then return Nothing
                    else return $ Just $ LogRef (last contexts) package line Nothing (Just (logLineNumber, logLineNumber)) ContextRef
            _ -> do
                defaultLineLogger log logLaunch out
                return Nothing)
    lift $ unless (null refs) $ do
        addLogRefs [last refs]
        lastContext

contextParser :: CharParser () SrcSpan
contextParser = try (do
        whiteSpace
        symbol "Logged breakpoint at" <|> symbol "Stopped at"
        whiteSpace
        srcSpanParser)
    <?> "historicContextParser"

logOutputForLiveContext :: IDEPackage
                        -> LogLaunch           -- ^ loglaunch
                        -> C.Sink ToolOutput IDEM ()
logOutputForLiveContext package logLaunch = logOutputForContext package logLaunch (getContexts . T.unpack)
    where
        getContexts [] = []
        getContexts line@(x:xs) = case parse contextParser "" line of
                                    Right desc -> desc : getContexts xs
                                    _          -> getContexts xs

logOutputForLiveContextDefault :: IDEPackage
                               -> C.Sink ToolOutput IDEM ()
logOutputForLiveContextDefault package = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    logOutputForLiveContext package defaultLogLaunch


logOutputForHistoricContext :: IDEPackage
                            -> LogLaunch           -- ^ loglaunch
                            -> C.Sink ToolOutput IDEM ()
logOutputForHistoricContext package logLaunch = logOutputForContext package logLaunch getContexts
    where
        getContexts line = case parse contextParser "" $ T.unpack line of
                                Right desc -> [desc]
                                _          -> []

logOutputForHistoricContextDefault :: IDEPackage
                                   -> C.Sink ToolOutput IDEM ()
logOutputForHistoricContextDefault package = do
    defaultLogLaunch <- lift getDefaultLogLaunch
    logOutputForHistoricContext package defaultLogLaunch