{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Data.EnumMap.Strict.Wrapper (EnumMap (..)) where

import Control.DeepSeq (NFData)
import Data.Bifunctor (first)
import Data.Data (Data)
import Data.EnumOrd (EnumOrd (..))
import Data.Functor.Classes
  ( Eq1,
    Ord1,
    Read1 (..),
    Show1 (..),
    readPrec1,
    showsPrec1,
  )
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Exts (IsList)
import Text.Read (Read (..))

newtype EnumMap k a = EnumMap {unEnumMap :: IntMap a}
  deriving
    ( Monoid,
      Semigroup,
      Foldable,
      Traversable,
      NFData,
      Data,
      IsList,
      Eq,
      Eq1,
      Ord,
      Ord1,
      Functor
    )

toMap :: Enum k => EnumMap k a -> Map (EnumOrd k) a
toMap =
  Map.fromList
    . fmap (first (EnumOrd . toEnum))
    . IntMap.toList
    . unEnumMap

fromMap :: Enum k => Map (EnumOrd k) a -> EnumMap k a
fromMap =
  EnumMap
    . IntMap.fromList
    . fmap (first (fromEnum . unEnumOrd))
    . Map.toList

instance (Enum k, Show k) => Show1 (EnumMap k) where
  liftShowsPrec sp sl p = liftShowsPrec sp sl p . toMap

instance (Enum k, Show k, Show a) => Show (EnumMap k a) where
  showsPrec = showsPrec1

instance (Enum k, Read k) => Read1 (EnumMap k) where
  liftReadPrec rp = fmap fromMap . liftReadPrec rp

instance (Enum k, Read k, Read a) => Read (EnumMap k a) where
  readPrec = readPrec1