Implement custom at and ix for NewInt types

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

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