diff --git a/ghc-debug-adapter/Development/Debug/Adapter/Flags.hs b/ghc-debug-adapter/Development/Debug/Adapter/Flags.hs --- a/ghc-debug-adapter/Development/Debug/Adapter/Flags.hs +++ b/ghc-debug-adapter/Development/Debug/Adapter/Flags.hs @@ -1,15 +1,12 @@ {-# LANGUAGE CPP, RecordWildCards, LambdaCase #-} module Development.Debug.Adapter.Flags where -import Data.Maybe import Data.Function import System.FilePath import System.Directory import Control.Monad.Except import Control.Monad.IO.Class -import qualified Data.List as L - import qualified HIE.Bios as HIE import qualified HIE.Bios.Types as HIE import qualified HIE.Bios.Environment as HIE @@ -19,6 +16,12 @@ { ghcInvocation :: [String] , libdir :: FilePath , units :: [String] + , rootDir :: FilePath + -- ^ Root dir as reported by the 'Cradle' + , componentDir :: FilePath + -- ^ Root dir of the loaded 'ComponentOptions'. + -- Important for multi-package cabal projects, as packages are not in the + -- root of the cradle, but in some sub-directory. } -- | Make 'HieBiosFlags' from the given target file @@ -28,6 +31,7 @@ let target = root relTarget explicitCradle <- HIE.findCradle target & liftIO + -- TODO: Use proper loggers here cradle <- maybe (HIE.loadImplicitCradle mempty target) (HIE.loadCradle mempty) explicitCradle & liftIO @@ -38,29 +42,38 @@ -- (HIE.getCompilerOptions depends on CWD being the proper root dir) let compilerOpts = liftIO $ withCurrentDirectory root $ #if MIN_VERSION_hie_bios(0,14,0) - HIE.getCompilerOptions target HIE.LoadFile cradle + HIE.getCompilerOptions target (HIE.LoadWithContext [target]) cradle #else HIE.getCompilerOptions target [] cradle #endif - HIE.ComponentOptions {HIE.componentOptions = flags} <- compilerOpts >>= unwrapCradleResult "Failed to get compiler options using hie-bios cradle" - + componentOpts <- compilerOpts >>= unwrapCradleResult "Failed to get compiler options using hie-bios cradle" #if __GLASGOW_HASKELL__ >= 913 -- fwrite-if-simplified-core requires a recent bug fix regarding GHCi loading -- ROMES:TODO: Re-enable as soon as I'm using Matthew's patch. -- ["-fwrite-if-simplified-core"] ++ #endif + let (units', flags') = extractUnits (HIE.componentOptions componentOpts) return HieBiosFlags - { ghcInvocation = [ relTarget | not $ any (`L.isSuffixOf` target) flags ] ++ -- TODO is this correct? else, the debugger won't work on single files. - flags ++ ghcDebuggerFlags + { ghcInvocation = flags' ++ ghcDebuggerFlags , libdir = libdir - , units = mapMaybe (\case ("-unit", u) -> Just u; _ -> Nothing) $ zip flags (drop 1 flags) + , units = units' + , rootDir = HIE.cradleRootDir cradle + , componentDir = HIE.componentRoot componentOpts } where unwrapCradleResult m = \case HIE.CradleNone -> throwError $ "HIE.CradleNone\n" ++ m HIE.CradleFail err -> throwError $ unlines (HIE.cradleErrorStderr err) ++ "\n" ++ m HIE.CradleSuccess x -> return x + +extractUnits :: [String] -> ([String], [String]) +extractUnits = go [] [] + where + -- TODO: we should likely use the 'processCmdLineP' instead + go units rest ("-unit" : x : xs) = go (x : units) rest xs + go units rest (x : xs) = go units (x : rest) xs + go units rest [] = (reverse units, reverse rest) -- | Flags specific to ghc-debugger to append to all GHC invocations. ghcDebuggerFlags :: [String] diff --git a/ghc-debug-adapter/Development/Debug/Adapter/Init.hs b/ghc-debug-adapter/Development/Debug/Adapter/Init.hs --- a/ghc-debug-adapter/Development/Debug/Adapter/Init.hs +++ b/ghc-debug-adapter/Development/Debug/Adapter/Init.hs @@ -108,7 +108,7 @@ finished_init <- liftIO $ newEmptyMVar registerNewDebugSession (maybe "debug-session" T.pack __sessionId) DAS{..} - [ debuggerThread finished_init writeDebuggerOutput projectRoot flags extraGhcArgs defaultRunConf syncRequests syncResponses + [ debuggerThread finished_init writeDebuggerOutput projectRoot flags extraGhcArgs entryFile defaultRunConf syncRequests syncResponses , handleDebuggerOutput readDebuggerOutput , stdoutCaptureThread , stderrCaptureThread @@ -166,13 +166,14 @@ -> FilePath -- ^ Working directory for GHC session -> HieBiosFlags -- ^ GHC Invocation flags -> [String] -- ^ Extra ghc args + -> FilePath -> Debugger.RunDebuggerSettings -- ^ Settings for running the debugger -> MVar D.Command -- ^ Read commands -> MVar D.Response -- ^ Write reponses -> (DebugAdaptorCont () -> IO ()) -- ^ Allows unlifting DebugAdaptor actions to IO. See 'registerNewDebugSession'. -> IO () -debuggerThread finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs runConf requests replies withAdaptor = do +debuggerThread finished_init writeDebuggerOutput workDir HieBiosFlags{..} extraGhcArgs mainFp runConf requests replies withAdaptor = do let finalGhcInvocation = ghcInvocation ++ extraGhcArgs @@ -188,9 +189,9 @@ catches (do - Debugger.runDebugger writeDebuggerOutput libdir units finalGhcInvocation runConf $ do + Debugger.runDebugger writeDebuggerOutput rootDir componentDir libdir units finalGhcInvocation mainFp runConf $ do liftIO $ signalInitialized (Right ()) - + forever $ do req <- takeMVar requests & liftIO resp <- (Debugger.execute req <&> Right) diff --git a/ghc-debugger.cabal b/ghc-debugger.cabal --- a/ghc-debugger.cabal +++ b/ghc-debugger.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghc-debugger -version: 0.3.0.0 +version: 0.4.0.0 synopsis: A step-through machine-interface debugger for GHC Haskell @@ -53,6 +53,7 @@ GHC.Debugger.Runtime.Term.Cache, GHC.Debugger.Monad, + GHC.Debugger.Session, GHC.Debugger.Interface.Messages -- other-modules: -- other-extensions: @@ -65,9 +66,11 @@ process >= 1.6.25 && < 1.7, unix >= 2.8.6 && < 2.9, filepath >= 1.5.4 && < 1.6, + directory >= 1.3.9.0 && < 1.4, exceptions >= 0.10.9 && < 0.11, bytestring >= 0.12.1 && < 0.13, aeson >= 2.2.3 && < 2.3, + hie-bios, hs-source-dirs: ghc-debugger default-language: Haskell2010 diff --git a/ghc-debugger/GHC/Debugger/Monad.hs b/ghc-debugger/GHC/Debugger/Monad.hs --- a/ghc-debugger/GHC/Debugger/Monad.hs +++ b/ghc-debugger/GHC/Debugger/Monad.hs @@ -3,9 +3,11 @@ import Prelude hiding (mod) import Data.Function +import qualified Data.Foldable as Foldable import System.Exit import System.IO import System.FilePath (normalise) +import System.Directory (makeAbsolute) import Control.Monad import Control.Monad.IO.Class import Control.Exception (assert) @@ -13,29 +15,21 @@ import Control.Monad.Catch import GHC -import GHC.Types.Name (mkDerivedInternalName) -import GHC.Types.Name.Occurrence (mkVarOcc) import qualified GHCi.BreakArray as BA import GHC.Driver.DynFlags as GHC -import GHC.Driver.Phases as GHC -import GHC.Driver.Pipeline as GHC -import GHC.Driver.Config.Logger as GHC -import GHC.Driver.Session.Units as GHC import GHC.Unit.Module.ModSummary as GHC import GHC.Utils.Outputable as GHC -import GHC.Utils.Monad as GHC import GHC.Utils.Logger as GHC import GHC.Types.Unique.Supply as GHC import GHC.Runtime.Loader as GHC import GHC.Runtime.Interpreter as GHCi import GHC.Runtime.Heap.Inspect import GHC.Unit.Module.Env as GHC -import GHC.Types.Name.Env import GHC.Driver.Env import Data.IORef import Data.Maybe -import qualified Data.List.NonEmpty as NE +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List as List import qualified Data.IntMap as IM @@ -44,6 +38,7 @@ import GHC.Debugger.Interface.Messages import GHC.Debugger.Runtime.Term.Key import GHC.Debugger.Runtime.Term.Cache +import GHC.Debugger.Session import System.Posix.Signals -- | A debugger action. @@ -103,13 +98,16 @@ -- | Run a 'Debugger' action on a session constructed from a given GHC invocation. runDebugger :: Handle -- ^ The handle to which GHC's output is logged. The debuggee output is not affected by this parameter. + -> FilePath -- ^ Cradle root directory + -> FilePath -- ^ Component root directory -> FilePath -- ^ The libdir (given with -B as an arg) -> [String] -- ^ The list of units included in the invocation -> [String] -- ^ The full ghc invocation (as constructed by hie-bios flags) + -> FilePath -- ^ Path to the main function -> RunDebuggerSettings -- ^ Other debugger run settings -> Debugger a -- ^ 'Debugger' action to run on the session constructed from this invocation -> IO a -runDebugger dbg_out libdir units ghcInvocation' conf (Debugger action) = do +runDebugger dbg_out rootDir compDir libdir units ghcInvocation' mainFp conf (Debugger action) = do let ghcInvocation = filter (\case ('-':'B':_) -> False; _ -> True) ghcInvocation' GHC.runGhc (Just libdir) $ do @@ -136,53 +134,23 @@ -- Override the logger to output to the given handle GHC.pushLogHook (const $ debuggerLoggerAction dbg_out) - logger1 <- GHC.getLogger - let logger2 = GHC.setLogFlags logger1 (GHC.initLogFlags dflags1) - - -- The rest of the arguments are "dynamic" - -- Leftover ones are presumably files - (dflags4, fileish_args, _dynamicFlagWarnings) <- - GHC.parseDynamicFlags logger2 dflags1 (map (GHC.mkGeneralLocated "on ghc-debugger command arg") ghcInvocation) + -- TODO: this is weird, we set the session dynflags now to initialise + -- the hsc_interp. + -- This is incredibly dubious + _ <- GHC.setSessionDynFlags dflags1 - let (dflags5, srcs, objs) = GHC.parseTargetFiles dflags4 (map GHC.unLoc fileish_args) + -- Initialise plugins here because the plugin author might already expect this + -- subsequent call to `getLogger` to be affected by a plugin. + GHC.initializeSessionPlugins - -- we've finished manipulating the DynFlags, update the session - _ <- GHC.setSessionDynFlags dflags5 + flagsAndTargets <- parseHomeUnitArguments mainFp compDir units ghcInvocation dflags1 rootDir + setupHomeUnitGraph (NonEmpty.toList flagsAndTargets) dflags6 <- GHC.getSessionDynFlags -- Should this be done in GHC= liftIO $ GHC.initUniqSupply (GHC.initialUnique dflags6) (GHC.uniqueIncrement dflags6) - -- Initialise plugins here because the plugin author might already expect this - -- subsequent call to `getLogger` to be affected by a plugin. - GHC.initializeSessionPlugins - hsc_env <- GHC.getSession - - hs_srcs <- case NE.nonEmpty units of - Just ne_units -> do - GHC.initMulti ne_units (\_ _ _ _ -> {-no options extra check-} pure ()) - Nothing -> do - case srcs of - [] -> return [] - _ -> do - let (hs_srcs, non_hs_srcs) = List.partition GHC.isHaskellishTarget srcs - - -- if we have no haskell sources from which to do a dependency - -- analysis, then just do one-shot compilation and/or linking. - -- This means that "ghc Foo.o Bar.o -o baz" links the program as - -- we expect. - if (null hs_srcs) - then liftIO (GHC.oneShot hsc_env GHC.NoStop srcs) >> return [] - else do - o_files <- GHC.mapMaybeM (\x -> liftIO $ GHC.compileFile hsc_env GHC.NoStop x) non_hs_srcs - dflags7 <- GHC.getSessionDynFlags - let dflags' = dflags7 { GHC.ldInputs = map (GHC.FileOption "") o_files ++ GHC.ldInputs dflags7 } - _ <- GHC.setSessionDynFlags dflags' - return $ map (uncurry (,Nothing,)) hs_srcs - - targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs - GHC.setTargets targets' ok_flag <- GHC.load GHC.LoadAllTargets when (GHC.failed ok_flag) (liftIO $ exitWith (ExitFailure 1)) @@ -192,7 +160,7 @@ -- TODO: Think about Note [GHCi and local Preludes] and what is done in `getImplicitPreludeImports` let preludeImp = GHC.IIDecl . GHC.simpleImportDecl $ GHC.mkModuleName "Prelude" mss <- getAllLoadedModules - GHC.setContext $ preludeImp : map (GHC.IIDecl . GHC.simpleImportDecl . GHC.ms_mod_name) mss + GHC.setContext $ preludeImp : map (GHC.IIModule . GHC.ms_mod) mss runReaderT action =<< initialDebuggerState @@ -299,9 +267,10 @@ -- | Get a 'ModSummary' of a loaded module given its 'FilePath' getModuleByPath :: FilePath -> Debugger (Either String ModSummary) getModuleByPath path = do - -- do this everytime as the loaded modules may have changed + -- do this every time as the loaded modules may have changed lms <- getAllLoadedModules - let matches ms = normalise (msHsFilePath ms) `List.isSuffixOf` path + absPath <- liftIO $ makeAbsolute path + let matches ms = normalise (msHsFilePath ms) == normalise absPath return $ case filter matches lms of [x] -> Right x [] -> Left $ "No module matched " ++ path ++ ".\nLoaded modules:\n" ++ show (map msHsFilePath lms) ++ "\n. Perhaps you've set a breakpoint on a module that isn't loaded into the session?" diff --git a/ghc-debugger/GHC/Debugger/Session.hs b/ghc-debugger/GHC/Debugger/Session.hs new file mode 100644 --- /dev/null +++ b/ghc-debugger/GHC/Debugger/Session.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE DerivingStrategies #-} + +-- | Initialise the GHC session for one or more home units. +-- +-- This code is inspired of HLS's session initialisation. +-- It would be great to extract common functions in the future. +module GHC.Debugger.Session ( + parseHomeUnitArguments, + setupHomeUnitGraph, + TargetDetails(..), + Target(..), + toGhcTarget, + ) + where + +import Control.Monad +import Control.Monad.IO.Class + +import qualified GHC +import GHC.Driver.DynFlags as GHC +import GHC.Driver.Monad +import qualified GHC.Driver.Session as GHC +import GHC.Utils.Monad as GHC +import GHC.Unit.Home.Graph +import GHC.Unit.Home.PackageTable +import GHC.Unit.Env +import GHC.Unit.Types +import qualified GHC.Unit.State as State +import GHC.Driver.Env +import GHC.Types.SrcLoc +import Language.Haskell.Syntax.Module.Name + +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Map as Map +import qualified Data.List as L +import qualified Data.Containers.ListUtils as L +import GHC.ResponseFile (expandResponse) +import HIE.Bios.Environment as HIE +import System.FilePath + +-- | Throws if package flags are unsatisfiable +parseHomeUnitArguments :: GhcMonad m + => FilePath -- ^ Main entry point function + -> FilePath -- ^ Component root. Important for multi-package cabal projects. + -> [String] + -> [String] -- ghcInvocation + -> DynFlags + -> FilePath -- ^ root dir, see Note [Root Directory] + -> m (NonEmpty.NonEmpty (DynFlags, [GHC.Target])) +parseHomeUnitArguments cfp compRoot units theOpts dflags rootDir = do + ((theOpts',_errs,_warns),_units) <- GHC.processCmdLineP [] [] (map noLoc theOpts) + case NonEmpty.nonEmpty units of + Just us -> initMulti us + Nothing -> do + (df, targets) <- initOne (map unLoc theOpts') + -- A special target for the file which caused this wonderful + -- component to be created. In case the cradle doesn't list all the targets for + -- the component, in which case things will be horribly broken anyway. + -- + -- When we have a singleComponent that is caused to be loaded due to a + -- file, we assume the file is part of that component. This is useful + -- for bare GHC sessions, such as many of the ones used in the testsuite + -- + -- We don't do this when we have multiple components, because each + -- component better list all targets or there will be anarchy. + -- It is difficult to know which component to add our file to in + -- that case. + -- Multi unit arguments are likely to come from cabal, which + -- does list all targets. + -- + -- If we don't end up with a target for the current file in the end, then + -- we will report it as an error for that file + let abs_fp = rootDir cfp + let special_target = mkSimpleTarget df abs_fp + pure $ (df, special_target : targets) NonEmpty.:| [] + where + initMulti unitArgFiles = + forM unitArgFiles $ \f -> do + args <- liftIO $ expandResponse [f] + initOne args + initOne this_opts = do + (dflags', targets') <- addCmdOpts this_opts dflags + + let targets = HIE.makeTargetsAbsolute root targets' + root = case workingDirectory dflags' of + Nothing -> compRoot + Just wdir -> compRoot wdir + let dflags'' = + setWorkingDirectory root $ + makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory + dflags' + return (dflags'', targets) + +setupHomeUnitGraph :: GhcMonad m => [(DynFlags, [GHC.Target])] -> m () +setupHomeUnitGraph flagsAndTargets = do + hsc_env <- GHC.getSession + (hsc_env', targetDetails) <- liftIO $ setupMultiHomeUnitGhcSession [".hs", ".lhs"] hsc_env flagsAndTargets + GHC.setSession hsc_env' + GHC.setTargets (fmap toGhcTarget targetDetails) + +-- | Set up the 'HomeUnitGraph' with empty 'HomeUnitEnv's. +createUnitEnvFromFlags :: NonEmpty.NonEmpty DynFlags -> IO HomeUnitGraph +createUnitEnvFromFlags unitDflags = do + let + newInternalUnitEnv dflags hpt = mkHomeUnitEnv State.emptyUnitState Nothing dflags hpt Nothing + + unitEnvList <- traverse (\dflags -> do + emptyHpt <- emptyHomePackageTable + pure (homeUnitId_ dflags, newInternalUnitEnv dflags emptyHpt)) unitDflags + + pure $ unitEnv_new (Map.fromList (NonEmpty.toList unitEnvList)) + +-- | Given a set of 'DynFlags', set up the 'UnitEnv' and 'HomeUnitEnv' for this +-- 'HscEnv'. +-- We assume the 'HscEnv' is "empty", e.g. wasn't already used to compile +-- anything. +initHomeUnitEnv :: [DynFlags] -> HscEnv -> IO HscEnv +initHomeUnitEnv unitDflags env = do + let dflags0 = hsc_dflags env + -- additionally, set checked dflags so we don't lose fixes + initial_home_graph <- createUnitEnvFromFlags (dflags0 NonEmpty.:| unitDflags) + let home_units = unitEnv_keys initial_home_graph + home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do + let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv + dflags = homeUnitEnv_dflags homeUnitEnv + old_hpt = homeUnitEnv_hpt homeUnitEnv + + (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags cached_unit_dbs home_units + + updated_dflags <- GHC.updatePlatformConstants dflags mconstants + pure HomeUnitEnv + { homeUnitEnv_units = unit_state + , homeUnitEnv_unit_dbs = Just dbs + , homeUnitEnv_dflags = updated_dflags + , homeUnitEnv_hpt = old_hpt + , homeUnitEnv_home_unit = Just home_unit + } + + let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup (homeUnitId_ dflags0) home_unit_graph + let unit_env = UnitEnv + { ue_platform = targetPlatform dflags1 + , ue_namever = GHC.ghcNameVersion dflags1 + , ue_home_unit_graph = home_unit_graph + , ue_current_unit = homeUnitId_ dflags0 + , ue_eps = ue_eps (hsc_unit_env env) + } + pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env + + +-- | Setup the given 'HscEnv' to hold a 'UnitEnv' +-- with all the given components. +-- We return the modified 'HscEnv' and all the 'TargetDetails' for +-- the given 'GHC.Target's. +setupMultiHomeUnitGhcSession + :: [String] -- ^ File extensions to consider. This is mostly a remnant of HLS. + -> HscEnv -- ^ An empty HscEnv that we can use the setup the session. + -> [(DynFlags, [GHC.Target])] -- ^ New components to be loaded. Expected to be non-empty. + -> IO (HscEnv, [TargetDetails]) +setupMultiHomeUnitGhcSession exts hsc_env cis = do + let dfs = map fst cis + + hscEnv' <- initHomeUnitEnv dfs hsc_env + -- TODO: this should be reported + -- _ <- maybeToList $ GHC.checkHomeUnitsClosed (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv') + ts <- forM cis $ \(df, targets) -> do + -- evaluate $ liftRnf rwhnf targets + + let mk t = fromTargetId (importPaths df) exts (homeUnitId_ df) (GHC.targetId t) + ctargets <- concatMapM mk targets + + return (L.nubOrdOn targetTarget ctargets) + pure (hscEnv', concat ts) + +data TargetDetails = TargetDetails + { targetTarget :: Target + -- ^ Simplified version of 'TargetId', storing enough information + -- + , targetLocations :: [FilePath] + -- ^ The physical location of 'targetTarget'. + -- Contains '-boot' file locations. + -- At this moment in time, these are unused, but could be used to create + -- convenient lookup table from 'FilePath' to 'TargetDetails'. + , targetUnitId :: UnitId + -- ^ UnitId of 'targetTarget'. + } + deriving (Eq, Ord) + +-- | A simplified view on a 'TargetId'. +-- +-- Implements 'Ord' and 'Show' which can be convenient. +data Target = TargetModule ModuleName | TargetFile FilePath + deriving ( Eq, Ord, Show ) + +-- | Turn a 'TargetDetails' into a 'GHC.Target'. +toGhcTarget :: TargetDetails -> GHC.Target +toGhcTarget (TargetDetails tid _ uid) = case tid of + TargetModule modl -> GHC.Target (GHC.TargetModule modl) True uid Nothing + TargetFile fp -> GHC.Target (GHC.TargetFile fp Nothing) True uid Nothing + +fromTargetId :: [FilePath] -- ^ import paths + -> [String] -- ^ extensions to consider + -> UnitId + -> GHC.TargetId + -> IO [TargetDetails] +-- For a target module we consider all the import paths +fromTargetId is exts unitId (GHC.TargetModule modName) = do + let fps = [i moduleNameSlashes modName -<.> ext <> boot + | ext <- exts + , i <- is + , boot <- ["", "-boot"] + ] + return [TargetDetails (TargetModule modName) fps unitId] +-- For a 'TargetFile' we consider all the possible module names +fromTargetId _ _ unitId (GHC.TargetFile f _) = do + let other + | "-boot" `L.isSuffixOf` f = dropEnd 5 f + | otherwise = (f ++ "-boot") + return [TargetDetails (TargetFile f) [f, other] unitId] + +-- ---------------------------------------------------------------------------- +-- GHC Utils that should likely be exposed by GHC +-- ---------------------------------------------------------------------------- + +mkSimpleTarget :: DynFlags -> FilePath -> GHC.Target +mkSimpleTarget df fp = GHC.Target (GHC.TargetFile fp Nothing) True (homeUnitId_ df) Nothing + +hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv +hscSetUnitEnv ue env = env { hsc_unit_env = ue } + +setWorkingDirectory :: FilePath -> DynFlags -> DynFlags +setWorkingDirectory p d = d { workingDirectory = Just p } + +-- ---------------------------------------------------------------------------- +-- Utils that we need, but don't want to incur an additional dependency for. +-- ---------------------------------------------------------------------------- + +-- | Drop a number of elements from the end of the list. +-- +-- > dropEnd 3 "hello" == "he" +-- > dropEnd 5 "bye" == "" +-- > dropEnd (-1) "bye" == "bye" +-- > \i xs -> dropEnd i xs `isPrefixOf` xs +-- > \i xs -> length (dropEnd i xs) == max 0 (length xs - max 0 i) +-- > \i -> take 3 (dropEnd 5 [i..]) == take 3 [i..] +dropEnd :: Int -> [a] -> [a] +dropEnd i xs + | i <= 0 = xs + | otherwise = f xs (drop i xs) + where f (a:as) (_:bs) = a : f as bs + f _ _ = []