{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}

module GHC.All(
    CppFlags(..), ParseFlags(..), defaultParseFlags,
    parseFlagsAddFixities, parseFlagsSetLanguage,
    ParseError(..), ModuleEx(..),
    parseModuleEx, createModuleEx, createModuleExWithFixities, ghcComments, modComments,
    parseExpGhcWithMode, parseImportDeclGhcWithMode, parseDeclGhcWithMode,
    ) where

import GHC.Driver.Ppr
import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import Util
import Data.Char
import Data.List.Extra
import Timing
import Language.Preprocessor.Cpphs
import System.IO.Extra
import Fixity
import Extension
import GHC.Data.FastString

import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.Fixity
import GHC.Types.Error
import GHC.Driver.Errors.Types

import GHC.Utils.Error
import GHC.Parser.Lexer hiding (context)
import GHC.LanguageExtensions.Type
import GHC.Driver.Session hiding (extensions)
import GHC.Data.Bag
import Data.Generics.Uniplate.DataOnly

import Language.Haskell.GhclibParserEx.GHC.Parser
import Language.Haskell.GhclibParserEx.Fixity
import GHC.Util

-- | What C pre processor should be used.
data CppFlags
    = CppSimple -- ^ Lines prefixed with @#@ are stripped.
    | Cpphs CpphsOptions -- ^ The @cpphs@ library is used.

-- | Created with 'defaultParseFlags', used by 'parseModuleEx'.
data ParseFlags = ParseFlags
    {ParseFlags -> CppFlags
cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').
    ,ParseFlags -> Maybe Language
baseLanguage :: Maybe Language -- ^ Base language (e.g. Haskell98, Haskell2010), defaults to 'Nothing'.
    ,ParseFlags -> [Extension]
enabledExtensions :: [Extension] -- ^ List of extensions enabled for parsing, defaults to many non-conflicting extensions.
    ,ParseFlags -> [Extension]
disabledExtensions :: [Extension] -- ^ List of extensions disabled for parsing, usually empty.
    ,ParseFlags -> [FixityInfo]
fixities :: [FixityInfo] -- ^ List of fixities to be aware of, defaults to those defined in @base@.
    }

-- | Default value for 'ParseFlags'.
defaultParseFlags :: ParseFlags
defaultParseFlags :: ParseFlags
defaultParseFlags = CppFlags
-> Maybe Language
-> [Extension]
-> [Extension]
-> [FixityInfo]
-> ParseFlags
ParseFlags CppFlags
CppSimple forall a. Maybe a
Nothing [Extension]
defaultExtensions [] [FixityInfo]
defaultFixities

-- | Given some fixities, add them to the existing fixities in 'ParseFlags'.
parseFlagsAddFixities :: [FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities :: [FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo]
fx ParseFlags
x = ParseFlags
x{fixities :: [FixityInfo]
fixities = [FixityInfo]
fx forall a. [a] -> [a] -> [a]
++ ParseFlags -> [FixityInfo]
fixities ParseFlags
x}

parseFlagsSetLanguage :: (Maybe Language, ([Extension], [Extension])) -> ParseFlags -> ParseFlags
parseFlagsSetLanguage :: (Maybe Language, ([Extension], [Extension]))
-> ParseFlags -> ParseFlags
parseFlagsSetLanguage (Maybe Language
l, ([Extension]
es, [Extension]
ds)) ParseFlags
x = ParseFlags
x{baseLanguage :: Maybe Language
baseLanguage = Maybe Language
l, enabledExtensions :: [Extension]
enabledExtensions = [Extension]
es, disabledExtensions :: [Extension]
disabledExtensions = [Extension]
ds}


runCpp :: CppFlags -> FilePath -> String -> IO String
runCpp :: CppFlags -> FilePath -> FilePath -> IO FilePath
runCpp CppFlags
CppSimple FilePath
_ FilePath
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [if FilePath
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath -> FilePath
trimStart FilePath
x then FilePath
"" else FilePath
x | FilePath
x <- FilePath -> [FilePath]
lines FilePath
x]
runCpp (Cpphs CpphsOptions
o) FilePath
file FilePath
x = FilePath -> FilePath
dropLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CpphsOptions -> FilePath -> FilePath -> IO FilePath
runCpphs CpphsOptions
o FilePath
file FilePath
x
    where
        -- LINE pragmas always inserted when locations=True
        dropLine :: FilePath -> FilePath
dropLine (FilePath -> (FilePath, FilePath)
line1 -> (FilePath
a,FilePath
b)) | FilePath
"{-# LINE " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
a = FilePath
b
        dropLine FilePath
x = FilePath
x

---------------------------------------------------------------------
-- PARSING

-- | A parse error.
data ParseError = ParseError
    { ParseError -> SrcSpan
parseErrorLocation :: SrcSpan -- ^ Location of the error.
    , ParseError -> FilePath
parseErrorMessage :: String  -- ^ Message about the cause of the error.
    , ParseError -> FilePath
parseErrorContents :: String -- ^ Snippet of several lines (typically 5) including a @>@ character pointing at the faulty line.
    }

-- | Result of 'parseModuleEx', representing a parsed module.
newtype ModuleEx = ModuleEx {
    ModuleEx -> Located HsModule
ghcModule :: Located HsModule
}

-- | Extract a complete list of all the comments in a module.
ghcComments :: ModuleEx -> [LEpaComment]
ghcComments :: ModuleEx -> [LEpaComment]
ghcComments = forall from to. Biplate from to => from -> [to]
universeBi forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEx -> Located HsModule
ghcModule

-- | Extract just the list of a modules' leading comments (pragmas).
modComments :: ModuleEx -> EpAnnComments
modComments :: ModuleEx -> EpAnnComments
modComments = forall ann. EpAnn ann -> EpAnnComments
comments forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule -> EpAnn AnnsModule
hsmodAnn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEx -> Located HsModule
ghcModule

-- | The error handler invoked when GHC parsing has failed.
ghcFailOpParseModuleEx :: String
                       -> FilePath
                       -> String
                       -> (SrcSpan, SDoc)
                       -> IO (Either ParseError ModuleEx)
ghcFailOpParseModuleEx :: FilePath
-> FilePath
-> FilePath
-> (SrcSpan, SDoc)
-> IO (Either ParseError ModuleEx)
ghcFailOpParseModuleEx FilePath
ppstr FilePath
file FilePath
str (SrcSpan
loc, SDoc
err) = do
   let pe :: FilePath
pe = case SrcSpan
loc of
            RealSrcSpan RealSrcSpan
r Maybe BufSpan
_ -> Int -> FilePath -> FilePath
context (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
r) FilePath
ppstr
            SrcSpan
_ -> FilePath
""
       msg :: FilePath
msg = DynFlags -> SDoc -> FilePath
GHC.Driver.Ppr.showSDoc DynFlags
baseDynFlags SDoc
err
   forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SrcSpan -> FilePath -> FilePath -> ParseError
ParseError SrcSpan
loc FilePath
msg FilePath
pe

-- GHC extensions to enable/disable given HSE parse flags.
ghcExtensionsFromParseFlags :: ParseFlags -> ([Extension], [Extension])
ghcExtensionsFromParseFlags :: ParseFlags -> ([Extension], [Extension])
ghcExtensionsFromParseFlags ParseFlags{enabledExtensions :: ParseFlags -> [Extension]
enabledExtensions=[Extension]
es, disabledExtensions :: ParseFlags -> [Extension]
disabledExtensions=[Extension]
ds}= ([Extension]
es, [Extension]
ds)

-- GHC fixities given HSE parse flags.
ghcFixitiesFromParseFlags :: ParseFlags -> [(String, GHC.Types.Fixity.Fixity)]
ghcFixitiesFromParseFlags :: ParseFlags -> [(FilePath, Fixity)]
ghcFixitiesFromParseFlags = forall a b. (a -> b) -> [a] -> [b]
map FixityInfo -> (FilePath, Fixity)
toFixity forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseFlags -> [FixityInfo]
fixities

-- These next two functions get called frorm 'Config/Yaml.hs' for user
-- defined hint rules.

parseModeToFlags :: ParseFlags -> DynFlags
parseModeToFlags :: ParseFlags -> DynFlags
parseModeToFlags ParseFlags
parseMode =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> Maybe Language -> DynFlags
lang_set (ParseFlags -> Maybe Language
baseLanguage ParseFlags
parseMode) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> Extension -> DynFlags
xopt_unset (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> Extension -> DynFlags
xopt_set DynFlags
baseDynFlags [Extension]
enable) [Extension]
disable
  where
    ([Extension]
enable, [Extension]
disable) = ParseFlags -> ([Extension], [Extension])
ghcExtensionsFromParseFlags ParseFlags
parseMode

parseExpGhcWithMode :: ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode ParseFlags
parseMode FilePath
s =
  let fixities :: [(FilePath, Fixity)]
fixities = ParseFlags -> [(FilePath, Fixity)]
ghcFixitiesFromParseFlags ParseFlags
parseMode
  in case FilePath -> DynFlags -> ParseResult (LHsExpr GhcPs)
parseExpression FilePath
s forall a b. (a -> b) -> a -> b
$ ParseFlags -> DynFlags
parseModeToFlags ParseFlags
parseMode of
    POk PState
pst GenLocated SrcSpanAnnA (HsExpr GhcPs)
a -> forall a. PState -> a -> ParseResult a
POk PState
pst forall a b. (a -> b) -> a -> b
$ forall a. Data a => [(FilePath, Fixity)] -> a -> a
applyFixities [(FilePath, Fixity)]
fixities GenLocated SrcSpanAnnA (HsExpr GhcPs)
a
    f :: ParseResult (LHsExpr GhcPs)
f@PFailed{} -> ParseResult (LHsExpr GhcPs)
f

parseImportDeclGhcWithMode :: ParseFlags -> String -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LImportDecl GhcPs)
parseImportDeclGhcWithMode ParseFlags
parseMode FilePath
s =
  FilePath -> DynFlags -> ParseResult (LImportDecl GhcPs)
parseImport FilePath
s forall a b. (a -> b) -> a -> b
$ ParseFlags -> DynFlags
parseModeToFlags ParseFlags
parseMode

parseDeclGhcWithMode :: ParseFlags -> String -> ParseResult (LHsDecl GhcPs)
parseDeclGhcWithMode :: ParseFlags -> FilePath -> ParseResult (LHsDecl GhcPs)
parseDeclGhcWithMode ParseFlags
parseMode FilePath
s =
  let fixities :: [(FilePath, Fixity)]
fixities = ParseFlags -> [(FilePath, Fixity)]
ghcFixitiesFromParseFlags ParseFlags
parseMode
  in case FilePath -> DynFlags -> ParseResult (LHsDecl GhcPs)
parseDeclaration FilePath
s forall a b. (a -> b) -> a -> b
$ ParseFlags -> DynFlags
parseModeToFlags ParseFlags
parseMode of
    POk PState
pst GenLocated SrcSpanAnnA (HsDecl GhcPs)
a -> forall a. PState -> a -> ParseResult a
POk PState
pst forall a b. (a -> b) -> a -> b
$ forall a. Data a => [(FilePath, Fixity)] -> a -> a
applyFixities [(FilePath, Fixity)]
fixities GenLocated SrcSpanAnnA (HsDecl GhcPs)
a
    f :: ParseResult (LHsDecl GhcPs)
f@PFailed{} -> ParseResult (LHsDecl GhcPs)
f

-- | Create a 'ModuleEx' from a GHC module. It is assumed the incoming
-- parsed module has not been adjusted to account for operator
-- fixities (it uses the HLint default fixities).
createModuleEx :: Located HsModule -> ModuleEx
createModuleEx :: Located HsModule -> ModuleEx
createModuleEx = [(FilePath, Fixity)] -> Located HsModule -> ModuleEx
createModuleExWithFixities (forall a b. (a -> b) -> [a] -> [b]
map FixityInfo -> (FilePath, Fixity)
toFixity [FixityInfo]
defaultFixities)

createModuleExWithFixities :: [(String, Fixity)] -> Located HsModule -> ModuleEx
createModuleExWithFixities :: [(FilePath, Fixity)] -> Located HsModule -> ModuleEx
createModuleExWithFixities [(FilePath, Fixity)]
fixities Located HsModule
ast =
  Located HsModule -> ModuleEx
ModuleEx (forall a. Data a => [(FilePath, Fixity)] -> a -> a
applyFixities (Located HsModule -> [(FilePath, Fixity)]
fixitiesFromModule Located HsModule
ast forall a. [a] -> [a] -> [a]
++ [(FilePath, Fixity)]
fixities) Located HsModule
ast)

-- | Parse a Haskell module. Applies the C pre processor, and uses
-- best-guess fixity resolution if there are ambiguities.  The
-- filename @-@ is treated as @stdin@. Requires some flags (often
-- 'defaultParseFlags'), the filename, and optionally the contents of
-- that file.
--
-- Note that certain programs, e.g. @main = do@ successfully parse
-- with GHC, but then fail with an error in the renamer. These
-- programs will return a successful parse.
parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ModuleEx)
parseModuleEx :: ParseFlags
-> FilePath -> Maybe FilePath -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags FilePath
file Maybe FilePath
str = forall a. FilePath -> FilePath -> IO a -> IO a
timedIO FilePath
"Parse" FilePath
file forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
  FilePath
str <- case Maybe FilePath
str of
    Just FilePath
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x
    Maybe FilePath
Nothing | FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
"-" -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getContentsUTF8
            | Bool
otherwise -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFileUTF8' FilePath
file
  FilePath
str <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
dropPrefix FilePath
"\65279" FilePath
str -- Remove the BOM if it exists, see #130.
  let enableDisableExts :: ([Extension], [Extension])
enableDisableExts = ParseFlags -> ([Extension], [Extension])
ghcExtensionsFromParseFlags ParseFlags
flags
  -- Read pragmas for the first time.
  DynFlags
dynFlags <- forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FilePath -> FilePath -> ParseError
parsePragmasErr FilePath
str) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (DynFlags
-> ([Extension], [Extension])
-> FilePath
-> FilePath
-> IO (Either FilePath DynFlags)
parsePragmasIntoDynFlags DynFlags
baseDynFlags ([Extension], [Extension])
enableDisableExts FilePath
file FilePath
str)
  DynFlags
dynFlags <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe Language -> DynFlags
lang_set DynFlags
dynFlags forall a b. (a -> b) -> a -> b
$ ParseFlags -> Maybe Language
baseLanguage ParseFlags
flags
  -- Avoid running cpp unless CPP is enabled, see #1075.
  FilePath
str <- if Bool -> Bool
not (Extension -> DynFlags -> Bool
xopt Extension
Cpp DynFlags
dynFlags) then forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
str else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CppFlags -> FilePath -> FilePath -> IO FilePath
runCpp (ParseFlags -> CppFlags
cppFlags ParseFlags
flags) FilePath
file FilePath
str
  -- If we preprocessed the file, re-read the pragmas.
  DynFlags
dynFlags <- if Bool -> Bool
not (Extension -> DynFlags -> Bool
xopt Extension
Cpp DynFlags
dynFlags) then forall (f :: * -> *) a. Applicative f => a -> f a
pure DynFlags
dynFlags
              else forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FilePath -> FilePath -> ParseError
parsePragmasErr FilePath
str) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (DynFlags
-> ([Extension], [Extension])
-> FilePath
-> FilePath
-> IO (Either FilePath DynFlags)
parsePragmasIntoDynFlags DynFlags
baseDynFlags ([Extension], [Extension])
enableDisableExts FilePath
file FilePath
str)
  DynFlags
dynFlags <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe Language -> DynFlags
lang_set DynFlags
dynFlags forall a b. (a -> b) -> a -> b
$ ParseFlags -> Maybe Language
baseLanguage ParseFlags
flags
  -- Done with pragmas. Proceed to parsing.
  case FilePath -> FilePath -> DynFlags -> ParseResult (Located HsModule)
fileToModule FilePath
file FilePath
str DynFlags
dynFlags of
    POk PState
s Located HsModule
a -> do
      let errs :: [MsgEnvelope GhcMessage]
errs = forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Messages e -> Bag (MsgEnvelope e)
getMessages forall a b. (a -> b) -> a -> b
$ PsMessage -> GhcMessage
GhcPsMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> b
snd (PState -> (Messages PsMessage, Messages PsMessage)
getPsMessages PState
s)
      if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MsgEnvelope GhcMessage]
errs then
        forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall {e} {p}.
Diagnostic e =>
p
-> FilePath
-> FilePath
-> FilePath
-> [MsgEnvelope e]
-> IO (Either ParseError ModuleEx)
parseFailureErr DynFlags
dynFlags FilePath
str FilePath
file FilePath
str [MsgEnvelope GhcMessage]
errs
      else do
        let fixes :: [(FilePath, Fixity)]
fixes = Located HsModule -> [(FilePath, Fixity)]
fixitiesFromModule Located HsModule
a forall a. [a] -> [a] -> [a]
++ ParseFlags -> [(FilePath, Fixity)]
ghcFixitiesFromParseFlags ParseFlags
flags
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Located HsModule -> ModuleEx
ModuleEx (forall a. Data a => [(FilePath, Fixity)] -> a -> a
applyFixities [(FilePath, Fixity)]
fixes Located HsModule
a)
    PFailed PState
s ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall {e} {p}.
Diagnostic e =>
p
-> FilePath
-> FilePath
-> FilePath
-> [MsgEnvelope e]
-> IO (Either ParseError ModuleEx)
parseFailureErr DynFlags
dynFlags FilePath
str FilePath
file FilePath
str forall a b. (a -> b) -> a -> b
$ forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Messages e -> Bag (MsgEnvelope e)
getMessages  forall a b. (a -> b) -> a -> b
$ PsMessage -> GhcMessage
GhcPsMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> b
snd (PState -> (Messages PsMessage, Messages PsMessage)
getPsMessages PState
s)
  where
    -- If parsing pragmas fails, synthesize a parse error from the
    -- error message.
    parsePragmasErr :: FilePath -> FilePath -> ParseError
parsePragmasErr FilePath
src FilePath
msg =
      let loc :: SrcLoc
loc = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (FilePath -> FastString
mkFastString FilePath
file) (Int
1 :: Int) (Int
1 :: Int)
      in SrcSpan -> FilePath -> FilePath -> ParseError
ParseError (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
loc SrcLoc
loc) FilePath
msg FilePath
src

    parseFailureErr :: p
-> FilePath
-> FilePath
-> FilePath
-> [MsgEnvelope e]
-> IO (Either ParseError ModuleEx)
parseFailureErr p
dynFlags FilePath
ppstr FilePath
file FilePath
str [MsgEnvelope e]
errs =
      let errMsg :: MsgEnvelope e
errMsg = forall a. [a] -> a
head [MsgEnvelope e]
errs
          loc :: SrcSpan
loc = forall e. MsgEnvelope e -> SrcSpan
errMsgSpan MsgEnvelope e
errMsg
          doc :: SDoc
doc = forall e. Diagnostic e => MsgEnvelope e -> SDoc
pprLocMsgEnvelope MsgEnvelope e
errMsg
      in FilePath
-> FilePath
-> FilePath
-> (SrcSpan, SDoc)
-> IO (Either ParseError ModuleEx)
ghcFailOpParseModuleEx FilePath
ppstr FilePath
file FilePath
str (SrcSpan
loc, SDoc
doc)

-- | Given a line number, and some source code, put bird ticks around the appropriate bit.
context :: Int -> String -> String
context :: Int -> FilePath -> FilePath
context Int
lineNo FilePath
src =
    [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) [FilePath]
ticks forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
5 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
lineNo forall a. Num a => a -> a -> a
- Int
3) forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
src forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"",FilePath
"",FilePath
"",FilePath
""]
    where ticks :: [FilePath]
ticks = forall a. Int -> [a] -> [a]
drop (Int
3 forall a. Num a => a -> a -> a
- Int
lineNo) [FilePath
"  ",FilePath
"  ",FilePath
"> ",FilePath
"  ",FilePath
"  "]