Unify regex/filtering code

ghcidOutput

@@ -1,7 +1 @@
-/home/justin/Haskell/loop/src/Dodge/DisplayInventory.hs:(134,16)-(136,62): warning: [GHC-62161] [-Wincomplete-patterns]
+All good (595 modules, at 00:00:33)
-    Pattern match(es) are non-exhaustive
-    In a case alternative:
-        Patterns of type ‘a’ not matched: p where p is not one of {(-1), 2}
-    |
-134 |         mstr = case i of
-    |                ^^^^^^^^^...

src/Dodge/Data/SelectionList.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE StrictData #-}
---{-# LANGUAGE DeriveGeneric #-}
---{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.SelectionList where
@@ -12,9 +10,6 @@ import Dodge.Data.CardinalPoint
 import Dodge.Data.ScreenPos
 import Picture.Data
 
---import Data.Aeson
---import Data.Aeson.TH
-
 data ListDisplayParams = ListDisplayParams
     { _ldpPos :: ScreenPos
     , _ldpScale :: Float
@@ -23,9 +18,7 @@ data ListDisplayParams = ListDisplayParams
     }
 
 data CursorDisplay
-    = BoundaryCursor
+    = BoundaryCursor {_cursSides :: [CardinalPoint]}
-        { _cursSides :: [CardinalPoint]
-        }
     | BackdropCursor
 
 data SelectionList a = SelectionList
@@ -33,10 +26,6 @@ data SelectionList a = SelectionList
     , _slSelPos :: Maybe Int
     }
 
---data SelectionSections a = SelectionSections
---    { _sssSections :: IntMap (SelectionSection a)
---    }
-
 data SectionCursor = SectionCursor
     { _scurPos :: Int
     , _scurSize :: Int
@@ -81,9 +70,5 @@ makeLenses ''ListDisplayParams
 makeLenses ''SelectionList
 makeLenses ''SelectionItem
 makeLenses ''SelectionSection
---makeLenses ''SelectionSections
 makeLenses ''SectionCursor
 makeLenses ''CursorDisplay
-
---deriveJSON defaultOptions ''SelectionItem
---deriveJSON defaultOptions ''SelectionList

src/Dodge/Default/World.hs

@@ -168,17 +168,10 @@ defaultDisplayInventory =
         , _diSections = defaultInvSections
         , _diSelection = Just (1,0)
         , _diSelectionExtra = 0
---        , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
         , _diInvFilter = mempty
         , _diCloseFilter = mempty
         }
 
---defaultSSSExtra :: SSSExtra
---defaultSSSExtra =
---    SSSExtra
---        { _sssFilters = IM.fromList [(-1, mempty), (2, mempty)]
---        }
-
 defaultInvSections :: IM.IntMap (SelectionSection ())
 defaultInvSections = IM.fromDistinctAscList $
                 zip

src/Dodge/DisplayInventory.hs

@@ -1,4 +1,4 @@
---{-# OPTIONS_GHC -fno-full-laziness #-}
+-- {-# OPTIONS_GHC -fno-full-laziness #-}
 module Dodge.DisplayInventory (
     toggleCombineInv,
     updateInventoryPositioning,
@@ -42,31 +42,36 @@ updateCombineSections ::
     IM.IntMap (SelectionSection CombinableItem) ->
     IM.IntMap (SelectionSection CombinableItem)
 updateCombineSections w cfig =
-        updateSectionsPositioning
+    updateSectionsPositioning
-            mselpos
+        (w ^? hud . hudElement . subInventory . ciSelection . _Just)
-            availablelines
+        (getAvailableListLines secondColumnParams cfig)
-            [(0, showncombs), (-1, filtinv)]
+        [(0, sclose), (-1, sfclose)]
   where
-    mselpos = w ^? hud . hudElement . subInventory . ciSelection . _Just
+    (sfclose,sclose) = filterSectionsPair (flip (andOrRegex $ regexCombs invitms))
-    availablelines = getAvailableListLines secondColumnParams cfig
+        allcombs "COMBINATIONS" $ mstr
+    invitms = fromMaybe mempty $ w ^? hud . hudElement . diSections . ix 0 . ssItems
     allcombs = IM.fromDistinctAscList $ zip [0 ..] $ combineList w
-    filtcombs = fromMaybe allcombs $ do
+--    filtcombs = fromMaybe allcombs $ do
-        str <- mstr
+--        str <- mstr
-        invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
+--        invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
-        return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
+--        return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
-    showncombs
+--    showncombs
-        | null filtcombs =
+--        | null filtcombs =
-            IM.singleton 0 $
+--            IM.singleton 0 $
-                SelectionInfo ["No possible combinations"] 1 False white 0
+--                SelectionInfo ["No possible combinations"] 1 False white 0
-        | otherwise = filtcombs
+--        | otherwise = filtcombs
-    filtinv = fromMaybe mempty $ do
+--    filterdisplay = fromMaybe mempty $ do
-        str <- mstr
+--        str <- mstr
-        return $
+--        return $
-            IM.singleton
+--            IM.singleton 0 $
-                0
+--                SelectionInfo
-                (SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
+--                    ["COMBINATIONS FILTER: " ++ str, numfiltitems]
+--                    2
+--                    True
+--                    white
+--                    0
     mstr = w ^? hud . hudElement . subInventory . ciFilter . _Just
-    numfiltitems = "  " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
+--    numfiltitems = "  " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
 
 regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci str = case str of
@@ -96,12 +101,11 @@ updateDisplaySections ::
     Configuration ->
     IM.IntMap (SelectionSection ()) ->
     IM.IntMap (SelectionSection ())
-updateDisplaySections w cfig sss =
+updateDisplaySections w cfig =
-        updateSectionsPositioning
+    updateSectionsPositioning
-            mselpos
+        mselpos
-            availablelines
+        (getAvailableListLines (invDisplayParams w) cfig)
-            addorder
+        addorder
-            sss
   where
     mselpos = w ^? hud . hudElement . diSelection . _Just
     addorder = case mselpos of
@@ -110,40 +114,70 @@ updateDisplaySections w cfig sss =
         Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
         Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
         _ -> reverse [filtinv, filtclose, closex, invx, youx]
-    (filtinv, invx) = filtpair (-1) invitems' "INV. "
+    (sfinv,sinv) = filterSectionsPair plainRegex invitems "INVTORY" $
-    (filtclose, closex) = filtpair 2 coitems' "NEARBY "
+            w ^? hud . hudElement . diInvFilter . _Just
+    (filtinv, invx) = ((-1,sfinv),(0,sinv))
+--        filtpair (-1) invitems "INV. " $
+--            w ^? hud . hudElement . diInvFilter . _Just
+    (sfclose,sclose) = filterSectionsPair plainRegex coitems "NEARBY" $
+            w ^? hud . hudElement . diCloseFilter . _Just
+    (filtclose, closex) = ((2,sfclose),(3,sclose))
+--        filtpair 2 coitems "NEARBY " $
+--            w ^? hud . hudElement . diCloseFilter . _Just
     youx = (1, youitems)
     youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
     thetext = displayFreeSlots nfreeslots
-    availablelines = getAvailableListLines (invDisplayParams w) cfig
+    coitems =
-    coitems' =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    invitems' =
+    invitems =
         IM.mapWithKey
-            (\k (y, x) -> invSelectionItem cr k (x ^. locLDT . ldtValue) y)
+            (\k (y, x) -> invSelectionItem y cr k (x ^. locLDT . ldtValue))
-            invlocs
+            (allInvLocs $ _crInv cr)
     cr = you w
-    invlocs = allInvLocs $ _crInv (you w)
     nfreeslots = crNumFreeSlots cr
-    filtpair i itms filtdescription =
+--    filtpair i itms filtdescription mstr =
-        ( (i, filtsis)
+--        ( (i, filtsis)
-        , (i + 1, itms')
+--        , (i + 1, itms')
-        )
+--        )
-      where
+--      where
-        mstr = case i of
+--        filtsis = fromMaybe mempty $ do
-            (-1) -> w ^? hud . hudElement . diInvFilter . _Just
+--            str <- mstr
-            2 -> w ^? hud . hudElement . diCloseFilter . _Just
+--            return $
-        filtsis = fromMaybe mempty $ do
+--                IM.singleton
-            str <- mstr
+--                    0
-            return $
+--                    (SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
-                IM.singleton
+--        itms' = fromMaybe itms $ do
+--            str <- mstr
+--            return $ IM.filter (plainRegex str) itms
+--        numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
+
+filterSectionsPair ::
+    (String -> SelectionItem a -> Bool) ->
+    IM.IntMap (SelectionItem a) ->
+    String ->
+    Maybe String ->
+    (IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a))
+filterSectionsPair filtfn itms filtdescription mfilt =
+    ( filtsis
+    , itms'
+    )
+  where
+    filtsis = fromMaybe mempty $ do
+        str <- mfilt
+        return $
+            IM.singleton
+                0
+                $ SelectionInfo
+                    [filtdescription ++ " FILTER: " ++ str, numfiltitems]
+                    2
+                    True
+                    white
                     0
-                    (SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
+    itms' = fromMaybe itms $ do
-        itms' = fromMaybe itms $ do
+        str <- mfilt
-            str <- mstr
+        return $ IM.filter (filtfn str) itms
-            return $ IM.filter (plainRegex str) itms
+    numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
-        numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
 invDimColor :: Color
 invDimColor = greyN 0.7

src/Dodge/Inventory/SelectionList.hs

@@ -1,38 +1,38 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Inventory.SelectionList (
     invSelectionItem,
     invSelectionItem',
     closeObjectToSelectionItem,
 ) where
 
-import Dodge.Item.Grammar
 import Dodge.Data.ComposedItem
-import Padding
-import Dodge.Equipment.Text
 import Dodge.Data.SelectionList
 import Dodge.Data.World
+import Dodge.Equipment.Text
 import Dodge.Item.Display
+import Dodge.Item.Grammar
 import Dodge.Item.InventoryColor
 import LensHelp
+import Padding
 import Picture.Base
 
 invSelectionItem' :: Creature -> Int -> ComposedItem -> SelectionItem ()
-invSelectionItem' cr i it = invSelectionItem cr i it 0
+invSelectionItem' = invSelectionItem 0
 
-invSelectionItem :: Creature -> Int -> ComposedItem -> Int -> SelectionItem ()
+invSelectionItem :: Int -> Creature -> Int -> ComposedItem -> SelectionItem ()
-invSelectionItem cr i ci indent =
+invSelectionItem indent cr i ci =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-        , _siHeight = _itInvSize itm
+        , _siHeight = _itInvSize $ _cItem ci
         , _siIsSelectable = True
         , _siColor = col
         , _siOffX = indent
         , _siPayload = ()
         }
   where
-    itm = _cItem ci
+    anyhotkey = maybe [] ((' ' :) . hotkeyToString) (cr ^? crInvHotkeys . ix i)
-    anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
+    anyequippos = maybe [] (rightPad 8 ' ' . (' ' :) . eqPosText) (cr ^? crInvEquipped . ix i)
-    anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
     col = itemInvColor ci
     pics = itemDisplay cr ci
 
@@ -65,8 +65,9 @@ closeObjectToSelectionItem e =
   where
     (pics, col) = closeObjectToTextPictures e
 
---
 closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
 closeObjectToTextPictures = \case
-    Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
+    Left flit ->
+        let it = _flIt flit
+         in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
     Right bt -> ([_btText bt], yellow)