{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeSynonymInstances       #-}

{-|

An API implementing a convenient syntax for defining maps.  This module was
born from the observation that a list of tuples is semantically ambiguous
about how duplicate keys should be handled.  Additionally, the syntax is
inherently rather cumbersome and difficult to work with.  This API takes
advantage of do notation to provide a very light syntax for defining maps
while at the same time eliminating the semantic ambiguity of alists.

Here's an example:

> foo :: MapSyntax Text Text
> foo = do
>   "firstName" ## "John"
>   "lastName"  ## "Smith"

-}

module Data.Map.Syntax
  (
  -- * Core API
    MapSyntaxM
  , MapSyntax
  , runMap
  , (##)
  , (#!)
  , (#?)
  , mapK
  , mapV
  , runMapSyntax
  , runMapSyntax'

  -- * Lower level functions
  , DupStrat(..)
  , ItemRep(..)
  , addStrat
  ) where


------------------------------------------------------------------------------
import           Control.Monad.State
import qualified Data.Map            as M

#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative
#endif
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Strategy to use for duplicates
data DupStrat = Replace | Ignore | Error

{-

Note: We don't use this seemingly more general formulation:

type DupStrat k v = k -> v -> v -> Either k v

...because it is contravariant in k and v and makes it impossible to implement
mapK and mapV.

-}

------------------------------------------------------------------------------
-- | Representation of an indivdual item in a map
data ItemRep k v = ItemRep
    { forall k v. ItemRep k v -> DupStrat
irStrat :: DupStrat
    , forall k v. ItemRep k v -> k
irKey :: k
    , forall k v. ItemRep k v -> v
irVal :: v
    }


------------------------------------------------------------------------------
type MapRep k v = [ItemRep k v] -> [ItemRep k v]


------------------------------------------------------------------------------
-- | A monad providing convenient syntax for defining maps.
newtype MapSyntaxM k v a = MapSyntaxM { forall k v a. MapSyntaxM k v a -> State (MapRep k v) a
unMapSyntax :: State (MapRep k v) a }
  deriving ((forall a b. (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b)
-> (forall a b. a -> MapSyntaxM k v b -> MapSyntaxM k v a)
-> Functor (MapSyntaxM k v)
forall a b. a -> MapSyntaxM k v b -> MapSyntaxM k v a
forall a b. (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
forall k v a b. a -> MapSyntaxM k v b -> MapSyntaxM k v a
forall k v a b. (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k v a b. (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
fmap :: forall a b. (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
$c<$ :: forall k v a b. a -> MapSyntaxM k v b -> MapSyntaxM k v a
<$ :: forall a b. a -> MapSyntaxM k v b -> MapSyntaxM k v a
Functor, Functor (MapSyntaxM k v)
Functor (MapSyntaxM k v) =>
(forall a. a -> MapSyntaxM k v a)
-> (forall a b.
    MapSyntaxM k v (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b)
-> (forall a b c.
    (a -> b -> c)
    -> MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v c)
-> (forall a b.
    MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b)
-> (forall a b.
    MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v a)
-> Applicative (MapSyntaxM k v)
forall a. a -> MapSyntaxM k v a
forall k v. Functor (MapSyntaxM k v)
forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v a
forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
forall a b.
MapSyntaxM k v (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
forall k v a. a -> MapSyntaxM k v a
forall a b c.
(a -> b -> c)
-> MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v c
forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v a
forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
forall k v a b.
MapSyntaxM k v (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
forall k v a b c.
(a -> b -> c)
-> MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k v a. a -> MapSyntaxM k v a
pure :: forall a. a -> MapSyntaxM k v a
$c<*> :: forall k v a b.
MapSyntaxM k v (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
<*> :: forall a b.
MapSyntaxM k v (a -> b) -> MapSyntaxM k v a -> MapSyntaxM k v b
$cliftA2 :: forall k v a b c.
(a -> b -> c)
-> MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v c
liftA2 :: forall a b c.
(a -> b -> c)
-> MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v c
$c*> :: forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
*> :: forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
$c<* :: forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v a
<* :: forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v a
Applicative, Applicative (MapSyntaxM k v)
Applicative (MapSyntaxM k v) =>
(forall a b.
 MapSyntaxM k v a -> (a -> MapSyntaxM k v b) -> MapSyntaxM k v b)
-> (forall a b.
    MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b)
-> (forall a. a -> MapSyntaxM k v a)
-> Monad (MapSyntaxM k v)
forall a. a -> MapSyntaxM k v a
forall k v. Applicative (MapSyntaxM k v)
forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
forall a b.
MapSyntaxM k v a -> (a -> MapSyntaxM k v b) -> MapSyntaxM k v b
forall k v a. a -> MapSyntaxM k v a
forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
forall k v a b.
MapSyntaxM k v a -> (a -> MapSyntaxM k v b) -> MapSyntaxM k v b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall k v a b.
MapSyntaxM k v a -> (a -> MapSyntaxM k v b) -> MapSyntaxM k v b
>>= :: forall a b.
MapSyntaxM k v a -> (a -> MapSyntaxM k v b) -> MapSyntaxM k v b
$c>> :: forall k v a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
>> :: forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
$creturn :: forall k v a. a -> MapSyntaxM k v a
return :: forall a. a -> MapSyntaxM k v a
Monad)


------------------------------------------------------------------------------

instance Semigroup (MapSyntax k v) where
  <> :: MapSyntax k v -> MapSyntax k v -> MapSyntax k v
(<>) = MapSyntax k v -> MapSyntax k v -> MapSyntax k v
forall a b.
MapSyntaxM k v a -> MapSyntaxM k v b -> MapSyntaxM k v b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)

instance Monoid (MapSyntax k v) where
  mempty :: MapSyntax k v
mempty = () -> MapSyntax k v
forall a. a -> MapSyntaxM k v a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> MapSyntax k v) -> () -> MapSyntax k v
forall a b. (a -> b) -> a -> b
$! ()
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

------------------------------------------------------------------------------
-- | Convenient type alias that will probably be used most of the time.
type MapSyntax k v = MapSyntaxM k v ()


------------------------------------------------------------------------------
-- | Low level add function for adding a specific DupStrat, key, and value.
addStrat :: DupStrat -> k -> v -> MapSyntax k v
addStrat :: forall k v. DupStrat -> k -> v -> MapSyntax k v
addStrat DupStrat
strat k
k v
v = [ItemRep k v] -> MapSyntax k v
forall k v. [ItemRep k v] -> MapSyntax k v
addStrat' [DupStrat -> k -> v -> ItemRep k v
forall k v. DupStrat -> k -> v -> ItemRep k v
ItemRep DupStrat
strat k
k v
v]


------------------------------------------------------------------------------
addStrat' :: [ItemRep k v] -> MapSyntax k v
addStrat' :: forall k v. [ItemRep k v] -> MapSyntax k v
addStrat' [ItemRep k v]
irs = State ([ItemRep k v] -> [ItemRep k v]) () -> MapSyntaxM k v ()
forall k v a. State (MapRep k v) a -> MapSyntaxM k v a
MapSyntaxM (State ([ItemRep k v] -> [ItemRep k v]) () -> MapSyntaxM k v ())
-> State ([ItemRep k v] -> [ItemRep k v]) () -> MapSyntaxM k v ()
forall a b. (a -> b) -> a -> b
$ (([ItemRep k v] -> [ItemRep k v])
 -> [ItemRep k v] -> [ItemRep k v])
-> State ([ItemRep k v] -> [ItemRep k v]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\[ItemRep k v] -> [ItemRep k v]
ir -> [ItemRep k v] -> [ItemRep k v]
ir ([ItemRep k v] -> [ItemRep k v])
-> ([ItemRep k v] -> [ItemRep k v])
-> [ItemRep k v]
-> [ItemRep k v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ItemRep k v]
irs [ItemRep k v] -> [ItemRep k v] -> [ItemRep k v]
forall a. [a] -> [a] -> [a]
++))


------------------------------------------------------------------------------
-- | Forces an entry to be added.  If the key already exists, its value is
-- overwritten.
(##) :: k -> v -> MapSyntax k v
## :: forall k v. k -> v -> MapSyntax k v
(##) = DupStrat -> k -> v -> MapSyntax k v
forall k v. DupStrat -> k -> v -> MapSyntax k v
addStrat DupStrat
Replace
infixr 0 ##


------------------------------------------------------------------------------
-- | Tries to add an entry, but if the key already exists, then 'runMap' will
-- return a Left with the list of offending keys.  This may be useful if name
-- collisions are bad and you want to know when they occur.
(#!) :: k -> v -> MapSyntax k v
#! :: forall k v. k -> v -> MapSyntax k v
(#!) = DupStrat -> k -> v -> MapSyntax k v
forall k v. DupStrat -> k -> v -> MapSyntax k v
addStrat DupStrat
Error
infixr 0 #!


------------------------------------------------------------------------------
-- | Inserts into the map only if the key does not already exist.  If the key
-- does exist, it silently continues without overwriting or generating an
-- error indication.
(#?) :: k -> v -> MapSyntax k v
#? :: forall k v. k -> v -> MapSyntax k v
(#?) = DupStrat -> k -> v -> MapSyntax k v
forall k v. DupStrat -> k -> v -> MapSyntax k v
addStrat DupStrat
Ignore
infixr 0 #?


------------------------------------------------------------------------------
-- | Runs the MapSyntaxM monad to generate a map.
runMap :: Ord k => MapSyntaxM k v a -> Either [k] (M.Map k v)
runMap :: forall k v a. Ord k => MapSyntaxM k v a -> Either [k] (Map k v)
runMap = (k -> Map k v -> Maybe v)
-> (k -> v -> Map k v -> Map k v)
-> MapSyntaxM k v a
-> Either [k] (Map k v)
forall map k v a.
Monoid map =>
(k -> map -> Maybe v)
-> (k -> v -> map -> map) -> MapSyntaxM k v a -> Either [k] map
runMapSyntax k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert


------------------------------------------------------------------------------
-- | Runs the MapSyntaxM monad to generate a map.
runMapSyntax
    :: (Monoid map)
    => (k -> map -> Maybe v)
    -- ^ Function that gets a key's value
    -> (k -> v -> map -> map)
    -- ^ Function to force-insert a key-value pair into the map
    -> MapSyntaxM k v a
    -> Either [k] map
runMapSyntax :: forall map k v a.
Monoid map =>
(k -> map -> Maybe v)
-> (k -> v -> map -> map) -> MapSyntaxM k v a -> Either [k] map
runMapSyntax = (k -> v -> v -> Maybe v)
-> (k -> map -> Maybe v)
-> (k -> v -> map -> map)
-> MapSyntaxM k v a
-> Either [k] map
forall map k v a.
Monoid map =>
(k -> v -> v -> Maybe v)
-> (k -> map -> Maybe v)
-> (k -> v -> map -> map)
-> MapSyntaxM k v a
-> Either [k] map
runMapSyntax' (\k
_ v
_ v
_ -> Maybe v
forall a. Maybe a
Nothing)


------------------------------------------------------------------------------
-- | Runs the MapSyntaxM monad to generate a map.  This function gives you the
-- full power of insertWith when duplicate keys are encountered.
--
-- Example:
--
-- > runMapSyntax' (\k new_val old_val -> Just $ old_val ++ new_val)
runMapSyntax'
    :: (Monoid map)
    => (k -> v -> v -> Maybe v)
    -- ^ Function to handle duplicate key insertion, similar to the first
    -- argument to insertWith.  If this function returns Nothing, then this is
    -- interpreted as an error.  If it is a Just, then the resulting value
    -- will be inserted into the map.
    -> (k -> map -> Maybe v)
    -- ^ Function that gets a key's value
    -> (k -> v -> map -> map)
    -- ^ Function to force-insert a key-value pair into the map
    -> MapSyntaxM k v a
    -> Either [k] map
runMapSyntax' :: forall map k v a.
Monoid map =>
(k -> v -> v -> Maybe v)
-> (k -> map -> Maybe v)
-> (k -> v -> map -> map)
-> MapSyntaxM k v a
-> Either [k] map
runMapSyntax' k -> v -> v -> Maybe v
dupFunc k -> map -> Maybe v
lookupEntry k -> v -> map -> map
forceIns MapSyntaxM k v a
ms =
    case ([k], map)
res of
      ([],map
m) -> map -> Either [k] map
forall a b. b -> Either a b
Right map
m
      ([k]
es,map
_) -> [k] -> Either [k] map
forall a b. a -> Either a b
Left [k]
es
  where
    res :: ([k], map)
res = (([k], map) -> ItemRep k v -> ([k], map))
-> ([k], map) -> [ItemRep k v] -> ([k], map)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([k], map) -> ItemRep k v -> ([k], map)
f ([k]
forall a. Monoid a => a
mempty, map
forall a. Monoid a => a
mempty) ([ItemRep k v] -> ([k], map)) -> [ItemRep k v] -> ([k], map)
forall a b. (a -> b) -> a -> b
$ State ([ItemRep k v] -> [ItemRep k v]) a
-> ([ItemRep k v] -> [ItemRep k v])
-> [ItemRep k v]
-> [ItemRep k v]
forall s a. State s a -> s -> s
execState (MapSyntaxM k v a -> State ([ItemRep k v] -> [ItemRep k v]) a
forall k v a. MapSyntaxM k v a -> State (MapRep k v) a
unMapSyntax MapSyntaxM k v a
ms) [ItemRep k v] -> [ItemRep k v]
forall a. a -> a
id []
    f :: ([k], map) -> ItemRep k v -> ([k], map)
f accum :: ([k], map)
accum@([k]
es,map
m) ir :: ItemRep k v
ir@ItemRep{k
v
DupStrat
irStrat :: forall k v. ItemRep k v -> DupStrat
irKey :: forall k v. ItemRep k v -> k
irVal :: forall k v. ItemRep k v -> v
irStrat :: DupStrat
irKey :: k
irVal :: v
..} =
      case k -> map -> Maybe v
lookupEntry k
irKey map
m of
        Just v
v1 -> ([k], map) -> ItemRep k v -> v -> ([k], map)
replace ([k], map)
accum ItemRep k v
ir v
v1
        Maybe v
Nothing -> ([k]
es, k -> v -> map -> map
forceIns k
irKey v
irVal map
m)

    replace :: ([k], map) -> ItemRep k v -> v -> ([k], map)
replace ([k]
es,map
m) ItemRep k v
ir v
v1 =
      case ItemRep k v -> DupStrat
forall k v. ItemRep k v -> DupStrat
irStrat ItemRep k v
ir of
        DupStrat
Replace -> ([k]
es, k -> v -> map -> map
forceIns (ItemRep k v -> k
forall k v. ItemRep k v -> k
irKey ItemRep k v
ir) (ItemRep k v -> v
forall k v. ItemRep k v -> v
irVal ItemRep k v
ir) map
m)
        DupStrat
Ignore -> ([k]
es, map
m)
        DupStrat
Error -> ([k], map) -> (v -> ([k], map)) -> Maybe v -> ([k], map)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([k]
es [k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++ [ItemRep k v -> k
forall k v. ItemRep k v -> k
irKey ItemRep k v
ir], map
m)
                       (\v
v -> ([k]
es, k -> v -> map -> map
forceIns (ItemRep k v -> k
forall k v. ItemRep k v -> k
irKey ItemRep k v
ir) v
v map
m)) (Maybe v -> ([k], map)) -> Maybe v -> ([k], map)
forall a b. (a -> b) -> a -> b
$
                       k -> v -> v -> Maybe v
dupFunc (ItemRep k v -> k
forall k v. ItemRep k v -> k
irKey ItemRep k v
ir) (ItemRep k v -> v
forall k v. ItemRep k v -> v
irVal ItemRep k v
ir) v
v1


------------------------------------------------------------------------------
execMapSyntax :: MapSyntaxM k v a -> MapRep k v
execMapSyntax :: forall k v a. MapSyntaxM k v a -> MapRep k v
execMapSyntax MapSyntaxM k v a
ms = State (MapRep k v) a -> MapRep k v -> MapRep k v
forall s a. State s a -> s -> s
execState (MapSyntaxM k v a -> State (MapRep k v) a
forall k v a. MapSyntaxM k v a -> State (MapRep k v) a
unMapSyntax MapSyntaxM k v a
ms) MapRep k v
forall a. a -> a
id


------------------------------------------------------------------------------
-- | Maps a function over all the keys.
mapK :: (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK :: forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK k1 -> k2
f MapSyntaxM k1 v a
ms = [ItemRep k2 v] -> MapSyntax k2 v
forall k v. [ItemRep k v] -> MapSyntax k v
addStrat' [ItemRep k2 v]
items
  where
    items :: [ItemRep k2 v]
items = (ItemRep k1 v -> ItemRep k2 v) -> [ItemRep k1 v] -> [ItemRep k2 v]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemRep k1 v
ir -> ItemRep k1 v
ir { irKey = f (irKey ir) }) ([ItemRep k1 v] -> [ItemRep k2 v])
-> [ItemRep k1 v] -> [ItemRep k2 v]
forall a b. (a -> b) -> a -> b
$ MapSyntaxM k1 v a -> MapRep k1 v
forall k v a. MapSyntaxM k v a -> MapRep k v
execMapSyntax MapSyntaxM k1 v a
ms []


------------------------------------------------------------------------------
-- | Maps a function over all the values.
mapV :: (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV :: forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV v1 -> v2
f MapSyntaxM k v1 a
ms = [ItemRep k v2] -> MapSyntax k v2
forall k v. [ItemRep k v] -> MapSyntax k v
addStrat' [ItemRep k v2]
items
  where
    items :: [ItemRep k v2]
items = (ItemRep k v1 -> ItemRep k v2) -> [ItemRep k v1] -> [ItemRep k v2]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemRep k v1
ir -> ItemRep k v1
ir { irVal = f (irVal ir ) }) ([ItemRep k v1] -> [ItemRep k v2])
-> [ItemRep k v1] -> [ItemRep k v2]
forall a b. (a -> b) -> a -> b
$ MapSyntaxM k v1 a -> MapRep k v1
forall k v a. MapSyntaxM k v a -> MapRep k v
execMapSyntax MapSyntaxM k v1 a
ms []