module Data.StrMap where

import           Data.Map  (Map)
import qualified Data.Map  as Map
import           Data.Text (Text)
import qualified Data.Text as Text

-- | A 'StrMap' is sort of like a 'HashMap', but sorts the keys on a 'Text'
-- representation. Additionally, it has more useful 'Semigroup' and 'Monoid'
-- instances that '(<>)' the values when present.
--
-- @since 0.1.0.0
newtype StrMap k a = StrMap (Map (AsStr k) a)
  deriving (StrMap k a -> StrMap k a -> Bool
(StrMap k a -> StrMap k a -> Bool)
-> (StrMap k a -> StrMap k a -> Bool) -> Eq (StrMap k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. Eq a => StrMap k a -> StrMap k a -> Bool
/= :: StrMap k a -> StrMap k a -> Bool
$c/= :: forall k a. Eq a => StrMap k a -> StrMap k a -> Bool
== :: StrMap k a -> StrMap k a -> Bool
$c== :: forall k a. Eq a => StrMap k a -> StrMap k a -> Bool
Eq, Eq (StrMap k a)
Eq (StrMap k a)
-> (StrMap k a -> StrMap k a -> Ordering)
-> (StrMap k a -> StrMap k a -> Bool)
-> (StrMap k a -> StrMap k a -> Bool)
-> (StrMap k a -> StrMap k a -> Bool)
-> (StrMap k a -> StrMap k a -> Bool)
-> (StrMap k a -> StrMap k a -> StrMap k a)
-> (StrMap k a -> StrMap k a -> StrMap k a)
-> Ord (StrMap k a)
StrMap k a -> StrMap k a -> Bool
StrMap k a -> StrMap k a -> Ordering
StrMap k a -> StrMap k a -> StrMap k a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k a. Ord a => Eq (StrMap k a)
forall k a. Ord a => StrMap k a -> StrMap k a -> Bool
forall k a. Ord a => StrMap k a -> StrMap k a -> Ordering
forall k a. Ord a => StrMap k a -> StrMap k a -> StrMap k a
min :: StrMap k a -> StrMap k a -> StrMap k a
$cmin :: forall k a. Ord a => StrMap k a -> StrMap k a -> StrMap k a
max :: StrMap k a -> StrMap k a -> StrMap k a
$cmax :: forall k a. Ord a => StrMap k a -> StrMap k a -> StrMap k a
>= :: StrMap k a -> StrMap k a -> Bool
$c>= :: forall k a. Ord a => StrMap k a -> StrMap k a -> Bool
> :: StrMap k a -> StrMap k a -> Bool
$c> :: forall k a. Ord a => StrMap k a -> StrMap k a -> Bool
<= :: StrMap k a -> StrMap k a -> Bool
$c<= :: forall k a. Ord a => StrMap k a -> StrMap k a -> Bool
< :: StrMap k a -> StrMap k a -> Bool
$c< :: forall k a. Ord a => StrMap k a -> StrMap k a -> Bool
compare :: StrMap k a -> StrMap k a -> Ordering
$ccompare :: forall k a. Ord a => StrMap k a -> StrMap k a -> Ordering
$cp1Ord :: forall k a. Ord a => Eq (StrMap k a)
Ord, Int -> StrMap k a -> ShowS
[StrMap k a] -> ShowS
StrMap k a -> String
(Int -> StrMap k a -> ShowS)
-> (StrMap k a -> String)
-> ([StrMap k a] -> ShowS)
-> Show (StrMap k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> StrMap k a -> ShowS
forall k a. (Show k, Show a) => [StrMap k a] -> ShowS
forall k a. (Show k, Show a) => StrMap k a -> String
showList :: [StrMap k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [StrMap k a] -> ShowS
show :: StrMap k a -> String
$cshow :: forall k a. (Show k, Show a) => StrMap k a -> String
showsPrec :: Int -> StrMap k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> StrMap k a -> ShowS
Show)

instance Semigroup a => Semigroup (StrMap k a) where
  StrMap Map (AsStr k) a
as <> :: StrMap k a -> StrMap k a -> StrMap k a
<> StrMap Map (AsStr k) a
bs = Map (AsStr k) a -> StrMap k a
forall k a. Map (AsStr k) a -> StrMap k a
StrMap (Map (AsStr k) a -> StrMap k a) -> Map (AsStr k) a -> StrMap k a
forall a b. (a -> b) -> a -> b
$
    (a -> a -> a)
-> Map (AsStr k) a -> Map (AsStr k) a -> Map (AsStr k) a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Map (AsStr k) a
as Map (AsStr k) a
bs

instance Semigroup a => Monoid (StrMap k a) where
  mempty :: StrMap k a
mempty = Map (AsStr k) a -> StrMap k a
forall k a. Map (AsStr k) a -> StrMap k a
StrMap Map (AsStr k) a
forall a. Monoid a => a
mempty

-- | Insert a value into a 'StrMap'.
--
-- @since 0.1.0.0
insert :: Show k => k -> a -> StrMap k a -> StrMap k a
insert :: k -> a -> StrMap k a -> StrMap k a
insert k
k a
a (StrMap Map (AsStr k) a
m) = Map (AsStr k) a -> StrMap k a
forall k a. Map (AsStr k) a -> StrMap k a
StrMap (AsStr k -> a -> Map (AsStr k) a -> Map (AsStr k) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k -> AsStr k
forall k. Show k => k -> AsStr k
asStr k
k) a
a Map (AsStr k) a
m)

-- | Lookup a value in the 'StrMap'.
--
-- @since 0.1.0.0
lookup :: Show k => k -> StrMap k a -> Maybe a
lookup :: k -> StrMap k a -> Maybe a
lookup k
k (StrMap Map (AsStr k) a
m) = AsStr k -> Map (AsStr k) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k -> AsStr k
forall k. Show k => k -> AsStr k
asStr k
k) Map (AsStr k) a
m

-- | A datatype for representing the keys of entries in a 'StrMap'.
-- Contains the original value as well as the 'Text'ual representation of
-- that value.
--
-- The 'Eq' and 'Ord' instances only use the 'Text' value.
--
-- @since 0.1.0.0
data AsStr k = AsStr { AsStr k -> Text
asStrText :: Text, AsStr k -> k
asStrValue :: k } deriving Int -> AsStr k -> ShowS
[AsStr k] -> ShowS
AsStr k -> String
(Int -> AsStr k -> ShowS)
-> (AsStr k -> String) -> ([AsStr k] -> ShowS) -> Show (AsStr k)
forall k. Show k => Int -> AsStr k -> ShowS
forall k. Show k => [AsStr k] -> ShowS
forall k. Show k => AsStr k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsStr k] -> ShowS
$cshowList :: forall k. Show k => [AsStr k] -> ShowS
show :: AsStr k -> String
$cshow :: forall k. Show k => AsStr k -> String
showsPrec :: Int -> AsStr k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> AsStr k -> ShowS
Show

instance Eq (AsStr k) where
  AsStr Text
a k
_ == :: AsStr k -> AsStr k -> Bool
== AsStr Text
b k
_ = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b

instance Ord (AsStr k) where
  AsStr Text
a k
_ compare :: AsStr k -> AsStr k -> Ordering
`compare` AsStr Text
b k
_ = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b

-- | Pack a value into an 'AsStr' of that value.
--
-- @since 0.1.0.0
asStr :: Show k => k -> AsStr k
asStr :: k -> AsStr k
asStr k
k = Text -> k -> AsStr k
forall k. Text -> k -> AsStr k
AsStr (String -> Text
Text.pack (k -> String
forall a. Show a => a -> String
show k
k)) k
k