    {-# 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 []