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

@@ -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
 #

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)
   -- --------------------------------------------------------------------------

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
     }

src/Swarm/Game/Location.hs

@@ -177,14 +177,14 @@ relativeTo targetDir referenceDir =
 --   Logic adapted from <https://gamedev.stackexchange.com/questions/49290/#comment213403_49300>.
 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',

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

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)

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

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 <comment https://github.com/swarm-game/swarm/pull/1181#discussion_r1151177735>).
+indexWrapNonEmpty ::
+  Integral b =>
+  NonEmpty a ->
+  -- | index
+  b ->
+  a
 indexWrapNonEmpty list idx =
   NE.toList list !! fromIntegral wrappedIdx
  where