From 25e64d5378822173bf780d474233d5afe4001eb4 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Mon, 25 Aug 2025 00:50:41 +0100
Subject: [PATCH] Implement custom at and ix for NewInt types

---
 src/Dodge/AssignHotkey.hs | 15 +++++++--------
 src/NewInt.hs             | 15 ++++++++++-----
 2 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/src/Dodge/AssignHotkey.hs b/src/Dodge/AssignHotkey.hs
index 71361dc89..812550058 100644
--- a/src/Dodge/AssignHotkey.hs
+++ b/src/Dodge/AssignHotkey.hs
@@ -1,6 +1,4 @@
-module Dodge.AssignHotkey (
-    assignHotkey,
-) where
+module Dodge.AssignHotkey (assignHotkey) where
 
 import Dodge.Data.Equipment.Misc
 import Control.Lens
@@ -11,11 +9,12 @@ import NewInt
 -- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or
 -- World
 assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld
-assignHotkey (NInt itid) hk lw = lw
+assignHotkey i hk lw = lw
         & handleoldposition
-        & hotkeys . at hk ?~ NInt itid
-        & imHotkeys . unNIntMap . at itid ?~ hk
+        & hotkeys . at hk ?~ i
+        -- & imHotkeys . unNIntMap . at itid ?~ hk
+        & imHotkeys . at i ?~ hk
   where
     handleoldposition = fromMaybe id $ do
-        olditid <- lw ^? hotkeys . ix hk . unNInt
-        return $ imHotkeys . unNIntMap . at olditid .~ Nothing
+        oldi <- lw ^? hotkeys . ix hk
+        return $ imHotkeys . at oldi .~ Nothing
diff --git a/src/NewInt.hs b/src/NewInt.hs
index 38ab5c36d..5eb1d1e7e 100644
--- a/src/NewInt.hs
+++ b/src/NewInt.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeFamilies #-}
+--{-# LANGUAGE StandaloneDeriving #-}
 module NewInt where
 
 --import qualified Data.IntSet as IS
@@ -19,11 +21,14 @@ newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
     deriving newtype (Monoid,Semigroup)
     deriving (Eq,Ord,Show,Read)
 
---instance Ixed (NewIntMap (NewInt a)) where
---    type Index (NewIntMap (NewInt a)) = NewInt a
---    type Index (NewIntMap (NewInt a)) = NewInt a
---    ix :: (NewInt a) -> IndexedTraversal' (NewIntMap (NewInt a))
---    ix (NInt k) (NewIntMap m) = NIntMap <$> ix k m
+type instance Index (NewIntMap a b) = NewInt a
+type instance IxValue (NewIntMap a b) = b
+
+instance Ixed (NewIntMap a b) where
+    ix (NInt i) f (NIntMap m) = fmap NIntMap (ix i f m)
+
+instance At (NewIntMap a b) where
+    at (NInt i) f (NIntMap m) = fmap NIntMap (at i f m)
 
 makeLenses ''NewInt
 makeLenses ''NewIntMap