diff --git a/Cabal-syntax/src/Distribution/Backpack.hs b/Cabal-syntax/src/Distribution/Backpack.hs index b30028bc41c..68443c98ef8 100644 --- a/Cabal-syntax/src/Distribution/Backpack.hs +++ b/Cabal-syntax/src/Distribution/Backpack.hs @@ -70,7 +70,7 @@ import qualified Data.Set as Set -- represent it as a 'DefiniteUnitId uid'. -- -- For a source component using Backpack, however, there is more --- structure as components may be parametrized over some signatures, and +-- structure as components may be parameterized over some signatures, and -- these \"holes\" may be partially or wholly filled. -- -- OpenUnitId plays an important role when we are mix-in linking, diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index c7d63533e52..fcaea52a587 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -6,7 +6,7 @@ -- | Cabal-like file AST types: 'Field', 'Section' etc -- --- These types are parametrized by an annotation. +-- These types are parameterized by an annotation. module Distribution.Fields.Field ( -- * Cabal file Field (..) diff --git a/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs b/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs index 601a1d579f6..2aa53d2b5dd 100644 --- a/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs +++ b/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs @@ -94,7 +94,7 @@ toPWarnings = Just $ PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss) toWarning LexInconsistentIndentation poss = Just $ PWarning PWTInconsistentIndentation (NE.head poss) $ "Inconsistent indentation. Indentation jumps at lines " ++ intercalate ", " (NE.toList $ fmap (show . positionRow) poss) - -- LexBraces warning about using { } delimeters is not reported as parser warning. + -- LexBraces warning about using { } delimiters is not reported as parser warning. toWarning LexBraces _ = Nothing diff --git a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs index ae4c0cfec6b..e9fced4f770 100644 --- a/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs +++ b/Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs @@ -679,7 +679,7 @@ processImports v fromBuildInfo commonStanzas = go [] fields' <- catMaybes <$> traverse (warnImport v) fields pure $ (fields', \x -> foldr (mergeCommonStanza fromBuildInfo) x acc) --- | Warn on "import" fields, also map to Maybe, so errorneous fields can be filtered +-- | Warn on "import" fields, also map to Maybe, so erroneous fields can be filtered warnImport :: CabalSpecVersion -> Field Position -> ParseResult (Maybe (Field Position)) warnImport v (Field (Name pos name) _) | name == "import" = do if specHasCommonStanzas v == NoCommonStanzas diff --git a/Cabal-syntax/src/Distribution/SPDX/LicenseId.hs b/Cabal-syntax/src/Distribution/SPDX/LicenseId.hs index 95d315906c7..998b17e6c69 100644 --- a/Cabal-syntax/src/Distribution/SPDX/LicenseId.hs +++ b/Cabal-syntax/src/Distribution/SPDX/LicenseId.hs @@ -677,7 +677,7 @@ data LicenseId deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data) instance Binary LicenseId where - -- Word16 is encoded in big endianess + -- Word16 is encoded in big endianness -- https://github.com/kolmodin/binary/blob/master/src/Data/Binary/Class.hs#L220-LL227 put = Binary.putWord16be . fromIntegral . fromEnum get = do diff --git a/Cabal-syntax/src/Distribution/Types/VersionInterval.hs b/Cabal-syntax/src/Distribution/Types/VersionInterval.hs index afd9d665631..efe04246cb8 100644 --- a/Cabal-syntax/src/Distribution/Types/VersionInterval.hs +++ b/Cabal-syntax/src/Distribution/Types/VersionInterval.hs @@ -95,7 +95,7 @@ isVersion0 = (==) version0 stage1 :: VersionRange -> [VersionInterval] stage1 = cataVersionRange alg where - -- version range leafs transform into singleton intervals + -- version range leaves transform into singleton intervals alg (ThisVersionF v) = [VersionInterval (LowerBound v InclusiveBound) (UpperBound v InclusiveBound)] alg (LaterVersionF v) = [VersionInterval (LowerBound v ExclusiveBound) NoUpperBound] alg (OrLaterVersionF v) = [VersionInterval (LowerBound v InclusiveBound) NoUpperBound] diff --git a/Cabal-tests/tests/ParserTests.hs b/Cabal-tests/tests/ParserTests.hs index 981be3b4cce..3a87df99481 100644 --- a/Cabal-tests/tests/ParserTests.hs +++ b/Cabal-tests/tests/ParserTests.hs @@ -140,7 +140,7 @@ errorTest fp = cabalGoldenTest fp correct $ do return $ toUTF8BS $ case x of Right gpd -> - "UNXPECTED SUCCESS\n" ++ + "UNEXPECTED SUCCESS\n" ++ showGenericPackageDescription gpd Left (v, errs) -> unlines $ ("VERSION: " ++ show v) : map (showPError fp) (NE.toList errs) diff --git a/Cabal-tests/tests/UnitTests/Distribution/SPDX.hs b/Cabal-tests/tests/UnitTests/Distribution/SPDX.hs index c0b339e83af..b9454c20d20 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/SPDX.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/SPDX.hs @@ -91,7 +91,7 @@ shouldReject = map License -- -- * "WITH exc" exceptions are rejected -- --- * There should be a way to interpert license as (conjunction of) +-- * There should be a way to interpret license as (conjunction of) -- OSI-accepted licenses or CC0 -- isAcceptableLicense :: License -> Bool diff --git a/Cabal/src/Distribution/GetOpt.hs b/Cabal/src/Distribution/GetOpt.hs index 7e31fa165f4..bd9ee4ac65c 100644 --- a/Cabal/src/Distribution/GetOpt.hs +++ b/Cabal/src/Distribution/GetOpt.hs @@ -134,11 +134,11 @@ zipDefault ad bd (a : as) (b : bs) = (a, b) : zipDefault ad bd as bs -- | Pretty printing of short options. -- * With required arguments can be given as: -- @-w PATH or -wPATH (but not -w=PATH)@ --- This is dislayed as: +-- This is displayed as: -- @-w PATH or -wPATH@ -- * With optional but default arguments can be given as: -- @-j or -jNUM (but not -j=NUM or -j NUM)@ --- This is dislayed as: +-- This is displayed as: -- @-j[NUM]@ fmtShort :: ArgDescr a -> Char -> String fmtShort (NoArg _) so = "-" ++ [so] @@ -152,11 +152,11 @@ fmtShort (OptArg _ _ ad) so = -- | Pretty printing of long options. -- * With required arguments can be given as: -- @--with-compiler=PATH (but not --with-compiler PATH)@ --- This is dislayed as: +-- This is displayed as: -- @--with-compiler=PATH@ -- * With optional but default arguments can be given as: -- @--jobs or --jobs=NUM (but not --jobs NUM)@ --- This is dislayed as: +-- This is displayed as: -- @--jobs[=NUM]@ fmtLong :: ArgDescr a -> String -> String fmtLong (NoArg _) lo = "--" ++ lo diff --git a/Cabal/src/Distribution/PackageDescription/Check/Common.hs b/Cabal/src/Distribution/PackageDescription/Check/Common.hs index 4c528831430..5bdf5c33fe7 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Common.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Common.hs @@ -79,7 +79,7 @@ partitionDeps ads ns ds = do -- shared targets that match fads = filter (flip elem dqs . fst) ads -- the names of such targets - inNam = nub $ map fst fads :: [UnqualComponentName] + inName = nub $ map fst fads :: [UnqualComponentName] -- the dependencies of such targets inDep = concatMap snd fads :: [Dependency] @@ -96,7 +96,7 @@ partitionDeps ads ns ds = do -- text, ← no warning, inherited -- monadacme ← warning! let fFun d = - notElem (unqualName d) inNam + notElem (unqualName d) inName && notElem (unqualName d) (map unqualName inDep) @@ -116,7 +116,7 @@ partitionDeps ads ns ds = do -- for important dependencies like base). checkPVP :: Monad m - => (String -> PackageCheck) -- Warn message dependend on name + => (String -> PackageCheck) -- Warn message depends on name -- (e.g. "base", "Cabal"). -> [Dependency] -> CheckM m () diff --git a/Cabal/src/Distribution/PackageDescription/Check/Monad.hs b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs index 23d37570800..979826567b6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Monad.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Monad.hs @@ -242,7 +242,7 @@ tellCM ck = do -- There are some errors which, even though severe, will -- be allowed by Hackage *if* under a non-default flag. isErrAllowable :: PackageCheck -> Bool - isErrAllowable c = case extractCheckExplantion c of + isErrAllowable c = case extractCheckExplanation c of (WErrorUnneeded _) -> True (JUnneeded _) -> True (FDeferTypeErrorsUnneeded _) -> True diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs index 8588333c1a5..f3507acc9e6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs +++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs @@ -25,7 +25,7 @@ module Distribution.PackageDescription.Check.Warning , ppPackageCheck , ppCheckExplanationId , isHackageDistError - , extractCheckExplantion + , extractCheckExplanation , filterPackageChecksById , filterPackageChecksByIdString ) where @@ -124,7 +124,7 @@ filterPackageChecksById cs is = filter ff cs ff c = flip notElem is . checkExplanationId - . extractCheckExplantion + . extractCheckExplanation $ c -- | Filter Package Check by Check explanation /string/. @@ -293,14 +293,14 @@ data CheckExplanation -- to be a ad hoc monoid. -- Convenience. -extractCheckExplantion :: PackageCheck -> CheckExplanation -extractCheckExplantion (PackageBuildImpossible e) = e -extractCheckExplantion (PackageBuildWarning e) = e -extractCheckExplantion (PackageDistSuspicious e) = e -extractCheckExplantion (PackageDistSuspiciousWarn e) = e -extractCheckExplantion (PackageDistInexcusable e) = e +extractCheckExplanation :: PackageCheck -> CheckExplanation +extractCheckExplanation (PackageBuildImpossible e) = e +extractCheckExplanation (PackageBuildWarning e) = e +extractCheckExplanation (PackageDistSuspicious e) = e +extractCheckExplanation (PackageDistSuspiciousWarn e) = e +extractCheckExplanation (PackageDistInexcusable e) = e --- | Identifier for the speficic 'CheckExplanation'. This ensures `--ignore` +-- | Identifier for the specific 'CheckExplanation'. This ensures `--ignore` -- can output a warning on unrecognised values. -- ☞ N.B.: should be kept in sync with 'CheckExplanation'. data CheckExplanationID @@ -590,7 +590,7 @@ type CheckExplanationIDString = String -- A one-word identifier for each CheckExplanation -- --- ☞ N.B: if you modify anything here, remeber to change the documentation +-- ☞ N.B: if you modify anything here, remember to change the documentation -- in @doc/cabal-commands.rst@! ppCheckExplanationId :: CheckExplanationID -> CheckExplanationIDString ppCheckExplanationId CIParseWarning = "parser-warning" diff --git a/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs b/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs index 66b4af7b05b..be5aa378796 100644 --- a/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs +++ b/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs @@ -10,7 +10,7 @@ -- Generating the PackageInfo_pkgname module. -- -- This is a module that Cabal generates for the benefit of packages. It --- enables them to find their package informations. +-- enables them to find their package information. module Distribution.Simple.Build.PackageInfoModule ( generatePackageInfoModule ) where diff --git a/Cabal/src/Distribution/Simple/BuildToolDepends.hs b/Cabal/src/Distribution/Simple/BuildToolDepends.hs index 01592a0970e..2a663ac74fd 100644 --- a/Cabal/src/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/src/Distribution/Simple/BuildToolDepends.hs @@ -13,7 +13,7 @@ import qualified Data.Map as Map import Distribution.Package import Distribution.PackageDescription --- | Same as 'desugarBuildTool', but requires atomic informations (package +-- | Same as 'desugarBuildTool', but requires atomic information (package -- name, executable names) instead of a whole 'PackageDescription'. desugarBuildToolSimple :: PackageName diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index b403bb4c01a..e7c9fbd17ea 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -624,8 +624,8 @@ data Command action -- | Mark command as hidden. Hidden commands don't show up in the 'progname -- help' or 'progname --help' output. hiddenCommand :: Command action -> Command action -hiddenCommand (Command name synopsys f _cmdType) = - Command name synopsys f HiddenCommand +hiddenCommand (Command name synopsis f _cmdType) = + Command name synopsis f HiddenCommand commandAddAction :: CommandUI flags diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 52395a56668..8cb454e3ca0 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -482,7 +482,7 @@ waySupported :: String -> Compiler -> Maybe Bool waySupported way comp = case compilerFlavor comp of GHC -> - -- Infomation about compiler ways is only accurately reported after + -- Information about compiler ways is only accurately reported after -- 9.10.1. Which is useful as this is before profiling dynamic support -- was introduced. (See GHC #24881) if compilerVersion comp >= mkVersion [9, 10, 1] diff --git a/Cabal/src/Distribution/Simple/Program/Types.hs b/Cabal/src/Distribution/Simple/Program/Types.hs index 630b22580cf..3b03f6353cf 100644 --- a/Cabal/src/Distribution/Simple/Program/Types.hs +++ b/Cabal/src/Distribution/Simple/Program/Types.hs @@ -143,7 +143,7 @@ data ConfiguredProgram = ConfiguredProgram , programMonitorFiles :: [FilePath] -- ^ In addition to the 'programLocation' where the program was found, -- these are additional locations that were looked at. The combination - -- of ths found location and these not-found locations can be used to + -- of this found location and these not-found locations can be used to -- monitor to detect when the re-configuring the program might give a -- different result (e.g. found in a different location). } diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 15c1d77f553..8369f4fc701 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -1102,7 +1102,7 @@ configureArgs bcHack flags = (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] (NoFlag, NoFlag) -> [] hc_flag_name - -- TODO kill off thic bc hack when defaultUserHooks is removed. + -- TODO kill off this bc hack when defaultUserHooks is removed. | bcHack = "--with-hc=" | otherwise = "--with-compiler=" optFlag name config_field = case config_field flags of diff --git a/Cabal/src/Distribution/Simple/SetupHooks/Rule.hs b/Cabal/src/Distribution/Simple/SetupHooks/Rule.hs index e75d2c29f89..d8a0166fc3e 100644 --- a/Cabal/src/Distribution/Simple/SetupHooks/Rule.hs +++ b/Cabal/src/Distribution/Simple/SetupHooks/Rule.hs @@ -723,7 +723,7 @@ on the build-system side, we don't have access to any of the types, and thus don how much to read in order to reconstruct the associated opaque 'ByteString'. To ensure we always serialise/deserialise including the length of the data, the 'ScopedArgument' newtype is used, with a custom 'Binary' instance that always -incldues the length. We use this newtype: +includes the length. We use this newtype: - in the definition of 'CommandData', for arguments to rules, - in the definition of 'DepsRes', for the result of dynamic dependency computations. diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs index d2e738900da..097255b286f 100644 --- a/Cabal/src/Distribution/Simple/Utils.hs +++ b/Cabal/src/Distribution/Simple/Utils.hs @@ -388,7 +388,7 @@ die' verbosity msg = withFrozenCallStack $ do =<< pure . addErrorPrefix =<< prefixWithProgName msg --- Type which will be a wrapper for cabal -expections and cabal-install exceptions +-- Type which will be a wrapper for cabal -exceptions and cabal-install exceptions data VerboseException a = VerboseException CallStack POSIXTime Verbosity a deriving (Show, Typeable) diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index 107eefc2766..7bfb1be5926 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -447,7 +447,7 @@ buildWays lbi = let -- enable-library-profiling (enable (static profiling way)) .p_o -- enable-shared (enabled dynamic way) .dyn_o - -- enable-profiling-shared (enable dyanmic profilng way) .p_dyn_o + -- enable-profiling-shared (enable dynamic profilng way) .p_dyn_o -- enable-library-vanilla (enable vanilla way) .o -- -- enable-executable-dynamic => build dynamic executables diff --git a/Cabal/src/Distribution/Utils/IOData.hs b/Cabal/src/Distribution/Utils/IOData.hs index 73e86493d1f..833fc8f4ee3 100644 --- a/Cabal/src/Distribution/Utils/IOData.hs +++ b/Cabal/src/Distribution/Utils/IOData.hs @@ -80,7 +80,7 @@ instance KnownIODataMode LBS.ByteString where -- | 'IOData' Wrapper for 'System.IO.hPutStr' and 'System.IO.hClose' -- --- This is the dual operation ot 'hGetIODataContents', +-- This is the dual operation to 'hGetIODataContents', -- and consequently the handle is closed with `hClose`. -- -- /Note:/ this performs lazy-IO. diff --git a/cabal-install-solver/tests/UnitTests/Distribution/Solver/Modular/MessageUtils.hs b/cabal-install-solver/tests/UnitTests/Distribution/Solver/Modular/MessageUtils.hs index a24d5672ddd..c72c8b5aa6f 100644 --- a/cabal-install-solver/tests/UnitTests/Distribution/Solver/Modular/MessageUtils.hs +++ b/cabal-install-solver/tests/UnitTests/Distribution/Solver/Modular/MessageUtils.hs @@ -58,9 +58,9 @@ isOutOfBounds :: Int -> String -> String -> Bool isOutOfBounds range a b = not $ withinRange range a b testRange :: Int -> [String] -> String -> Assertion -testRange range elems erronousElement = assertBool "String should be out of bounds to make a spelling suggestion" (isOutOfBounds range erronousElement suggestion) +testRange range elems erroneousElement = assertBool "String should be out of bounds to make a spelling suggestion" (isOutOfBounds range erroneousElement suggestion) where - suggestion = mostSimilarElement erronousElement elems + suggestion = mostSimilarElement erroneousElement elems outOfBounds :: [String] outOfBounds = diff --git a/cabal-install/src/Distribution/Client/Check.hs b/cabal-install/src/Distribution/Client/Check.hs index f8c1d456751..69635ba8ed0 100644 --- a/cabal-install/src/Distribution/Client/Check.hs +++ b/cabal-install/src/Distribution/Client/Check.hs @@ -57,7 +57,7 @@ readGenericPackageDescriptionCheck verbosity fpath = do dieWithException verbosity ParseError Right x -> return (warnings, x) --- | Checks a packge for common errors. Returns @True@ if the package +-- | Checks a package for common errors. Returns @True@ if the package -- is fit to upload to Hackage, @False@ otherwise. -- Note: must be called with the CWD set to the directory containing -- the '.cabal' file. diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index a5df21b185b..75e673e895f 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -390,7 +390,7 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project -- NOTE: CmdInstall and project local packages. -- -- CmdInstall always installs packages from a source distribution that, in case of unpackage - -- pacakges, is created automatically. This is implemented in getSpecsAndTargetSelectors. + -- packages, is created automatically. This is implemented in getSpecsAndTargetSelectors. -- -- This has the inconvenience that the planner will consider all packages as non-local -- (see `ProjectPlanning.shouldBeLocal`) and that any project or cli configuration will @@ -1031,7 +1031,7 @@ installLibraries -- See ticket #8894. This is safe to include any nonreinstallable boot pkg, -- but the particular package users will always expect to be in scope without specific installation --- is base, so that they can access prelude, regardles of if they specifically asked for it. +-- is base, so that they can access prelude, regardless of if they specifically asked for it. globalPackages :: [PackageName] globalPackages = mkPackageName <$> ["base"] diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index f762c3d72bf..a75524bbca6 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -408,7 +408,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g return (buildCtx, compiler, configureReplOptions & lReplOptionsFlags %~ (++ repl_flags), targets) - -- Multi Repl implemention see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for + -- Multi Repl implementation see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for -- a high-level overview about how everything fits together. if Set.size (distinctTargetComponents targets) > 1 then withTempDirectoryEx verbosity tempFileOptions distDir "multi-out" $ \dir' -> do @@ -440,7 +440,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g let sp = intercalate [searchPathSeparator] (map fst (sortBy (comparing @Int snd) $ Map.toList (combine_search_paths all_paths))) -- HACK: Just combine together all env overrides, placing the most common things last - -- ghc program with overriden PATH + -- ghc program with overridden PATH (ghcProg, _) <- requireProgram verbosity ghcProgram (pkgConfigCompilerProgs (elaboratedShared buildCtx')) let ghcProg' = ghcProg{programOverrideEnv = [("PATH", Just sp)]} diff --git a/cabal-install/src/Distribution/Client/IndexUtils/ActiveRepos.hs b/cabal-install/src/Distribution/Client/IndexUtils/ActiveRepos.hs index daa4ec86355..51079d7c347 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils/ActiveRepos.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils/ActiveRepos.hs @@ -168,7 +168,7 @@ organizeByRepos -> [a] -> Either String [(a, CombineStrategy)] organizeByRepos (ActiveRepos xs0) sel ys0 = - -- here we use lazyness to do only one traversal + -- here we use laziness to do only one traversal let (rest, result) = case go rest xs0 ys0 of Right (rest', result') -> (rest', Right result') Left err -> ([], Left err) diff --git a/cabal-install/src/Distribution/Client/JobControl.hs b/cabal-install/src/Distribution/Client/JobControl.hs index 9cc7ac92a05..0d8fa0acf36 100644 --- a/cabal-install/src/Distribution/Client/JobControl.hs +++ b/cabal-install/src/Distribution/Client/JobControl.hs @@ -174,7 +174,7 @@ readAllTChan qvar = go [] Nothing -> return (reverse xs) Just x -> go (x : xs) --- | Make a 'JobControl' where the parallism is controlled by a semaphore. +-- | Make a 'JobControl' where the parallelism is controlled by a semaphore. -- -- This uses the GHC -jsem option to allow GHC to take additional semaphore slots -- if we are not using them all. diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index ccace6f8025..4efd32e48c0 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -632,7 +632,7 @@ rebuildInstallPlan -- Configuring other programs. -- - -- Having configred the compiler, now we configure all the remaining + -- Having configured the compiler, now we configure all the remaining -- programs. This is to check we can find them, and to monitor them for -- changes. -- @@ -902,7 +902,7 @@ reportPlanningFailure projectConfig comp platform pkgSpecifiers = buildReports platform where - -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely? + -- TODO may want to handle the projectConfigLogFile parameter here, or just remove it entirely? reportFailure = Cabal.fromFlag . projectConfigReportPlanningFailure . projectConfigBuildOnly $ projectConfig pkgids = mapMaybe theSpecifiedPackage pkgSpecifiers diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 95db58bc8c1..f397f4342c5 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -414,8 +414,8 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm return tmpDir rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) -scriptComponenetName :: IsString s => FilePath -> s -scriptComponenetName scriptPath = fromString cname +scriptComponentName :: IsString s => FilePath -> s +scriptComponentName scriptPath = fromString cname where cname = "script-" ++ map censor (takeFileName scriptPath) censor c @@ -437,7 +437,7 @@ scriptDistDirParams scriptPath ctx compiler platform = , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization } where - cn = scriptComponenetName scriptPath + cn = scriptComponentName scriptPath cid = mkComponentId $ prettyShow fakePackageId <> "-inplace-" <> prettyShow cn optimization = (packageConfigOptimization . projectConfigLocalPackages . projectConfig) ctx @@ -475,7 +475,7 @@ updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do sourcePackage = fakeProjectSourcePackage projectRoot & lSrcpkgDescription . L.condExecutables - .~ [(scriptComponenetName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])] + .~ [(scriptComponentName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])] executable = scriptExecutable & L.modulePath .~ absScript diff --git a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs index 39c719f2e1f..9db7109fbc6 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs @@ -316,9 +316,9 @@ renderDotGraph :: Graph -> String renderDotGraph graph = unlines ( [header - ,graphDefaultAtribs - ,nodeDefaultAtribs - ,edgeDefaultAtribs] + ,graphDefaultAttribs + ,nodeDefaultAttribs + ,edgeDefaultAttribs] ++ map renderNode (vertices graph) ++ map renderEdge (edges graph) ++ [footer] @@ -328,12 +328,12 @@ renderDotGraph graph = renderEdge (n, n') = "\t" ++ show n ++ " -> " ++ show n' ++ "[];" -header, footer, graphDefaultAtribs, nodeDefaultAtribs, edgeDefaultAtribs :: String +header, footer, graphDefaultAttribs, nodeDefaultAttribs, edgeDefaultAttribs :: String header = "digraph packages {" footer = "}" -graphDefaultAtribs = "\tgraph [fontsize=14, fontcolor=black, color=black];" -nodeDefaultAtribs = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];" -edgeDefaultAtribs = "\tedge [fontsize=10];" +graphDefaultAttribs = "\tgraph [fontsize=14, fontcolor=black, color=black];" +nodeDefaultAttribs = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];" +edgeDefaultAttribs = "\tedge [fontsize=10];" -} diff --git a/templates/SPDX.LicenseId.template.hs b/templates/SPDX.LicenseId.template.hs index 58e04801398..a7de395410f 100644 --- a/templates/SPDX.LicenseId.template.hs +++ b/templates/SPDX.LicenseId.template.hs @@ -38,7 +38,7 @@ data LicenseId deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data) instance Binary LicenseId where - -- Word16 is encoded in big endianess + -- Word16 is encoded in big endianness -- https://github.com/kolmodin/binary/blob/master/src/Data/Binary/Class.hs#L220-LL227 put = Binary.putWord16be . fromIntegral . fromEnum get = do