Vendor ListT, removed in transformers-0.6 (Fix #1010) (#1027)

`ListT` is used in a utility module for package search.  The functions in the utility module implement some heuristics to extract words from package identifiers.  The module is undocumented.
It does not seem worthwhile at this point to reverse engineer this module and try to implement it w/o `ListT`.
Rather, I embed the `ListT` monad transformer code here so we do not depend on getting it from `transformers` (where it has disappeared from since `>= 0.6`).
This also silences the deprecation warnings.

Author: andreasabel

src/Distribution/Server/Features/Search/ExtractNameTerms.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE BangPatterns, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Distribution.Server.Features.Search.ExtractNameTerms (
     extractPackageNameTerms,
-    extractModuleNameTerms,
   ) where
 
 import Data.Text (Text)
@@ -14,12 +15,11 @@ import Data.Maybe (maybeToList)
 
 import Data.Functor.Identity
 import Control.Monad
-import Control.Monad.List
 import Control.Monad.Writer
 import Control.Monad.State
 import Control.Applicative
 
-
+-- UNUSED:
 extractModuleNameTerms :: String -> [Text]
 extractModuleNameTerms modname =
   map T.toCaseFold $
@@ -180,3 +180,82 @@ main = do
       , let mods = exposedModules lib
       , mod <- mods ]
 -}
+
+------------------------------------------------------------------------
+-- Vendoring deprecated ListT
+------------------------------------------------------------------------
+
+-- Monad transformers @ListT@ got removed in @transformers-0.6.0@
+-- so we vendor it here.
+-- It does not seem worthwhile rewriting this module to not use @ListT@,
+-- because:
+--
+--   - It is entirely undocumented.  It does not specify what the
+--     module is trying to achieve.
+--
+--   - Individual functions are also not documented, neither
+--     their invariants nor their expected behavior.
+--
+--   - The only exported function extractPackageNameTerms
+--     seems to be only used in a package search facility.
+--     Thus, it is not important from a security perspective.
+--
+--   - This module might become obsolete once package search
+--     is rewritten.
+--
+-- Andreas Abel, 2022-03-06
+
+newtype ListT m a = ListT { runListT :: m [a] }
+
+-- | Map between 'ListT' computations.
+--
+-- * @'runListT' ('mapListT' f m) = f ('runListT' m)@
+mapListT :: (m [a] -> n [b]) -> ListT m a -> ListT n b
+mapListT f m = ListT $ f (runListT m)
+{-# INLINE mapListT #-}
+
+instance (Functor m) => Functor (ListT m) where
+    fmap f = mapListT $ fmap $ map f
+    {-# INLINE fmap #-}
+
+instance (Foldable f) => Foldable (ListT f) where
+    foldMap f (ListT a) = foldMap (foldMap f) a
+    {-# INLINE foldMap #-}
+
+instance (Traversable f) => Traversable (ListT f) where
+    traverse f (ListT a) = ListT <$> traverse (traverse f) a
+    {-# INLINE traverse #-}
+
+instance (Applicative m) => Applicative (ListT m) where
+    pure a  = ListT $ pure [a]
+    {-# INLINE pure #-}
+    f <*> v = ListT $ (<*>) <$> runListT f <*> runListT v
+    {-# INLINE (<*>) #-}
+
+instance (Applicative m) => Alternative (ListT m) where
+    empty   = ListT $ pure []
+    {-# INLINE empty #-}
+    m <|> n = ListT $ (++) <$> runListT m <*> runListT n
+    {-# INLINE (<|>) #-}
+
+instance (Monad m) => Monad (ListT m) where
+    m >>= k  = ListT $ do
+        a <- runListT m
+        b <- mapM (runListT . k) a
+        return (concat b)
+    {-# INLINE (>>=) #-}
+
+instance (Monad m) => MonadPlus (ListT m) where
+    mzero       = ListT $ return []
+    {-# INLINE mzero #-}
+    m `mplus` n = ListT $ do
+        a <- runListT m
+        b <- runListT n
+        return (a ++ b)
+    {-# INLINE mplus #-}
+
+instance MonadTrans ListT where
+    lift m = ListT $ do
+        a <- m
+        return [a]
+    {-# INLINE lift #-}