From 346f960085bc382a95daa78dba61eb3ab82abe3a Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 1 Oct 2023 20:13:20 -0700 Subject: [PATCH] more partial function bans (#1564) Towards #1494. Replaced/restricted uses of `Prelude.tail` and `Prelude.!!`. Quarantined `undefined`. Introduced a new function `listEnumsNonempty` that is guaranteed safe. --- .hlint.yaml | 8 +++++++- src/Swarm/Doc/Gen.hs | 4 ++-- src/Swarm/Game/Achievement/Attainment.hs | 2 +- src/Swarm/Game/Location.hs | 8 ++++---- src/Swarm/Game/ResourceLoading.hs | 2 +- src/Swarm/Language/Key.hs | 2 +- src/Swarm/Language/Pretty.hs | 5 +++-- src/Swarm/Util.hs | 20 ++++++++++++++++++-- 8 files changed, 37 insertions(+), 14 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 305096240..ac153292d 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -27,7 +27,13 @@ - functions: - {name: Data.List.head, within: []} - {name: Prelude.head, within: []} - - {name: Data.List.NonEmpty.fromList, within: [Swarm.Util, Swarm.Util.Parse]} + - {name: Data.List.NonEmpty.fromList, within: [Swarm.Util]} + - {name: Prelude.tail, within: []} + - {name: Prelude.!!, within: [Swarm.Util.indexWrapNonEmpty, TestEval]} + - {name: undefined, within: [Swarm.Language.Key, TestUtil]} + - {name: fromJust, within: []} +# - {name: Data.Map.!, within: []} # TODO: #1494 +# - {name: error, within: []} # TODO: #1494 # Add custom hints for this project # diff --git a/src/Swarm/Doc/Gen.hs b/src/Swarm/Doc/Gen.hs index 4058fa864..86cab0386 100644 --- a/src/Swarm/Doc/Gen.hs +++ b/src/Swarm/Doc/Gen.hs @@ -512,12 +512,12 @@ recipesToDot baseRobot classicTerm emap recipes = do -- order entities into clusters based on how "far" they are from -- what is available at the start - see 'recipeLevels'. bottom <- wrapBelowAbove worldEntities - ls <- zipWithM subLevel [1 ..] (tail levels) + ls <- zipWithM subLevel [1 ..] (drop 1 levels) let invisibleLine = zipWithM_ (.~>.) tls <- mapM (const hiddenNode) levels bls <- mapM (const hiddenNode) levels invisibleLine tls bls - invisibleLine bls (tail tls) + invisibleLine bls (drop 1 tls) let sameBelowAbove (b1, t1) (b2, t2) = Dot.same [b1, b2] >> Dot.same [t1, t2] zipWithM_ sameBelowAbove (bottom : ls) (zip bls tls) -- -------------------------------------------------------------------------- diff --git a/src/Swarm/Game/Achievement/Attainment.hs b/src/Swarm/Game/Achievement/Attainment.hs index f1995ceef..b19b318af 100644 --- a/src/Swarm/Game/Achievement/Attainment.hs +++ b/src/Swarm/Game/Achievement/Attainment.hs @@ -57,5 +57,5 @@ instance ToJSON Attainment where achievementJsonOptions :: Options achievementJsonOptions = defaultOptions - { fieldLabelModifier = tail -- drops leading underscore + { fieldLabelModifier = drop 1 -- drops leading underscore } diff --git a/src/Swarm/Game/Location.hs b/src/Swarm/Game/Location.hs index a53a232ed..b3f3e8a6c 100644 --- a/src/Swarm/Game/Location.hs +++ b/src/Swarm/Game/Location.hs @@ -177,14 +177,14 @@ relativeTo targetDir referenceDir = -- Logic adapted from . nearestDirection :: Heading -> AbsoluteDir nearestDirection coord = - orderedDirs !! index + Util.indexWrapNonEmpty orderedDirs index where angle :: Double angle = unangle (fmap fromIntegral coord) / (2 * pi) - index = round (fromIntegral enumCount * angle) `mod` enumCount - orderedDirs = Util.listEnums - enumCount = length orderedDirs + index :: Int + index = round $ fromIntegral (length orderedDirs) * angle + orderedDirs = Util.listEnumsNonempty -- | Convert a 'Direction' into a corresponding 'Heading'. Note that -- this only does something reasonable for 'DNorth', 'DSouth', 'DEast', diff --git a/src/Swarm/Game/ResourceLoading.hs b/src/Swarm/Game/ResourceLoading.hs index 1232326bd..010c07b93 100644 --- a/src/Swarm/Game/ResourceLoading.hs +++ b/src/Swarm/Game/ResourceLoading.hs @@ -149,4 +149,4 @@ initNameGenerator appDataMap = do Nothing -> throwError $ AssetNotLoaded (Data NameGeneration) (into @FilePath f <.> "txt") (DoesNotExist File) - Just content -> return . tail . T.lines $ content + Just content -> return . drop 1 . T.lines $ content diff --git a/src/Swarm/Language/Key.hs b/src/Swarm/Language/Key.hs index 82c069106..4f9471dab 100644 --- a/src/Swarm/Language/Key.hs +++ b/src/Swarm/Language/Key.hs @@ -134,4 +134,4 @@ prettyKey = from @String . \case V.KChar c -> [c] V.KFun n -> 'F' : show n - k -> tail (show k) + k -> drop 1 (show k) diff --git a/src/Swarm/Language/Pretty.hs b/src/Swarm/Language/Pretty.hs index 1cfd5e9a4..103e7a725 100644 --- a/src/Swarm/Language/Pretty.hs +++ b/src/Swarm/Language/Pretty.hs @@ -14,6 +14,7 @@ import Control.Unification import Control.Unification.IntVar import Data.Bool (bool) import Data.Functor.Fixedpoint (Fix, unFix) +import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as M import Data.Set (Set) import Data.Set qualified as S @@ -29,7 +30,7 @@ import Swarm.Language.Parse (getLocRange) import Swarm.Language.Syntax import Swarm.Language.Typecheck import Swarm.Language.Types -import Swarm.Util (showLowT) +import Swarm.Util (showEnum, showLowT) import Witch ------------------------------------------------------------ @@ -167,7 +168,7 @@ instance PrettyPrec Direction where prettyPrec _ = pretty . directionSyntax instance PrettyPrec Capability where - prettyPrec _ c = pretty $ T.toLower (from (tail $ show c)) + prettyPrec _ c = pretty $ T.toLower (from (NE.tail $ showEnum c)) instance PrettyPrec Const where prettyPrec p c = pparens (p > fixity (constInfo c)) $ pretty . syntax . constInfo $ c diff --git a/src/Swarm/Util.hs b/src/Swarm/Util.hs index a8d124ddd..08424dbc5 100644 --- a/src/Swarm/Util.hs +++ b/src/Swarm/Util.hs @@ -15,6 +15,7 @@ module Swarm.Util ( maximum0, cycleEnum, listEnums, + listEnumsNonempty, showEnum, indexWrapNonEmpty, uniq, @@ -145,13 +146,28 @@ cycleEnum e listEnums :: (Enum e, Bounded e) => [e] listEnums = [minBound .. maxBound] +-- | Members of the Bounded class are guaranteed to +-- have at least one element. +listEnumsNonempty :: (Enum e, Bounded e) => NonEmpty e +listEnumsNonempty = NE.fromList listEnums + -- | We know by the syntax rules of Haskell that constructor -- names must consist of one or more symbols! showEnum :: (Show e, Enum e) => e -> NonEmpty Char showEnum = NE.fromList . show --- | Guaranteed to yield an element of the list -indexWrapNonEmpty :: Integral b => NonEmpty a -> b -> a +-- | Guaranteed to yield an element of the list. +-- +-- This is true even if the supplied @index@ is negative, +-- since 'mod' always satisfies @0 <= a `mod` b < b@ +-- when @b@ is positive +-- (see ). +indexWrapNonEmpty :: + Integral b => + NonEmpty a -> + -- | index + b -> + a indexWrapNonEmpty list idx = NE.toList list !! fromIntegral wrappedIdx where