From 7599c898ef91383ab86bb9f9f99f07313e9221e2 Mon Sep 17 00:00:00 2001
From: Tony Zorman <soliditsallgood@mailbox.org>
Date: Sun, 15 Oct 2023 11:31:40 +0200
Subject: [PATCH] X.Prelude: Add infinite stream type

Stolen from X.A.MostRecentlyUsed. This can be used in favour of lists
when we know the generated lists are definitely infinite.
---
 XMonad/Actions/MostRecentlyUsed.hs | 18 +------------
 XMonad/Actions/Plane.hs            |  2 +-
 XMonad/Config/Dmwit.hs             |  2 +-
 XMonad/Prelude.hs                  | 42 ++++++++++++++++++++++++++++--
 XMonad/Prompt.hs                   |  2 +-
 5 files changed, 44 insertions(+), 22 deletions(-)

diff --git a/XMonad/Actions/MostRecentlyUsed.hs b/XMonad/Actions/MostRecentlyUsed.hs
index c183805e..59513a3c 100644
--- a/XMonad/Actions/MostRecentlyUsed.hs
+++ b/XMonad/Actions/MostRecentlyUsed.hs
@@ -68,6 +68,7 @@ import XMonad.Util.PureX
   (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
 import XMonad.Util.History (History, origin, event, erase, ledger)
 import XMonad.Actions.Repeatable (repeatableSt)
+import XMonad.Prelude (Stream (..), cycleS)
 
 -- }}}
 
@@ -208,20 +209,3 @@ winHistEH ev = All True <$ case ev of
   where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }
 
 -- }}}
-
--- --< Auxiliary Data Type: Stream >-- {{{
-
--- To satisfy the almighty exhaustivity checker.
-
-data Stream a = !a :~ Stream a
-infixr 5 :~
-
-(+~) :: [a] -> Stream a -> Stream a
-xs +~ s = foldr (:~) s xs
-infixr 5 +~
-
-cycleS :: NonEmpty a -> Stream a
-cycleS (x :| xs) = s where s = x :~ xs +~ s
-
--- }}}
-
diff --git a/XMonad/Actions/Plane.hs b/XMonad/Actions/Plane.hs
index dd692d80..d6a4b3f8 100644
--- a/XMonad/Actions/Plane.hs
+++ b/XMonad/Actions/Plane.hs
@@ -41,7 +41,7 @@ module XMonad.Actions.Plane
 
 import Data.Map (Map, fromList)
 
-import XMonad.Prelude
+import XMonad.Prelude hiding (fromList)
 import XMonad
 import XMonad.StackSet hiding (workspaces)
 import XMonad.Util.Run
diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs
index 72fa3212..768fd41a 100644
--- a/XMonad/Config/Dmwit.hs
+++ b/XMonad/Config/Dmwit.hs
@@ -34,7 +34,7 @@ import XMonad.Layout.Grid
 import XMonad.Layout.IndependentScreens hiding (withScreen)
 import XMonad.Layout.Magnifier
 import XMonad.Layout.NoBorders
-import XMonad.Prelude
+import XMonad.Prelude hiding (fromList)
 import XMonad.Util.Dzen hiding (x, y)
 import XMonad.Util.SpawnOnce
 -- }}}
diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs
index ce6e92fe..d52f4902 100644
--- a/XMonad/Prelude.hs
+++ b/XMonad/Prelude.hs
@@ -1,7 +1,9 @@
 {-# OPTIONS_GHC -Wno-dodgy-imports #-}
 {-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE InstanceSigs        #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
 --------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Prelude
@@ -37,6 +39,13 @@ module XMonad.Prelude (
     multimediaKeys,
     functionKeys,
     WindowScreen,
+
+    -- * Infinite streams
+    Stream(..),
+    (+~),
+    cycleS,
+    toList,
+    fromList,
 ) where
 
 import Foreign (alloca, peek)
@@ -46,7 +55,7 @@ import Control.Applicative as Exports
 import Control.Monad       as Exports
 import Data.Bool           as Exports
 import Data.Char           as Exports
-import Data.Foldable       as Exports
+import Data.Foldable       as Exports hiding (toList)
 import Data.Function       as Exports
 import Data.Functor        as Exports hiding (unzip)
 import Data.List           as Exports hiding ((!?))
@@ -57,14 +66,15 @@ import Data.Traversable    as Exports
 import qualified Data.Map.Strict as Map
 
 import Control.Arrow ((&&&), first)
+import Control.Exception (SomeException, handle)
 import Data.Bifunctor (bimap)
 import Data.Bits
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Tuple (swap)
+import GHC.Exts (IsList(..))
 import GHC.Stack
 import System.Directory (getHomeDirectory)
 import System.Environment (getEnv)
-import Control.Exception (SomeException, handle)
 import qualified XMonad.StackSet as W
 
 -- | Short for 'fromIntegral'.
@@ -466,3 +476,31 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $
 -- | The specialized 'W.Screen' derived from 'WindowSet'.
 type WindowScreen -- FIXME move to core
     = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
+
+-- | An infinite stream type
+data Stream a = !a :~ Stream a
+infixr 5 :~
+
+instance Functor Stream where
+  fmap :: (a -> b) -> Stream a -> Stream b
+  fmap f = go
+   where go (x :~ xs) = f x :~ go xs
+
+instance IsList (Stream a) where
+  type (Item (Stream a)) = a
+
+  fromList :: [a] -> Stream a
+  fromList (x : xs) = x :~ fromList xs
+  fromList []       = errorWithoutStackTrace "XMonad.Prelude.Stream.fromList: Can't create stream out of finite list."
+
+  toList :: Stream a -> [a]
+  toList (x :~ xs) = x : toList xs
+
+-- | Absorb a list into an infinite stream.
+(+~) :: [a] -> Stream a -> Stream a
+xs +~ s = foldr (:~) s xs
+infixr 5 +~
+
+-- | Absorb a non-empty list into an infinite stream.
+cycleS :: NonEmpty a -> Stream a
+cycleS (x :| xs) = s where s = x :~ xs +~ s
diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs
index 020cfa6a..37ebe838 100644
--- a/XMonad/Prompt.hs
+++ b/XMonad/Prompt.hs
@@ -99,7 +99,7 @@ module XMonad.Prompt
     ) where
 
 import           XMonad                       hiding (cleanMask, config)
-import           XMonad.Prelude               hiding (toList)
+import           XMonad.Prelude               hiding (toList, fromList)
 import qualified XMonad.StackSet              as W
 import           XMonad.Util.Font
 import           XMonad.Util.Types