{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Map.Syntax
(
MapSyntaxM
, MapSyntax
, runMap
, (##)
, (#!)
, (#?)
, mapK
, mapV
, runMapSyntax
, runMapSyntax'
, 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
data DupStrat = Replace | Ignore | Error
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]
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
type MapSyntax k v = MapSyntaxM k v ()
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]
++))
(##) :: 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 ##
(#!) :: 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 #!
(#?) :: 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 #?
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
runMapSyntax
:: (Monoid map)
=> (k -> map -> Maybe v)
-> (k -> v -> map -> 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)
runMapSyntax'
:: (Monoid map)
=> (k -> v -> v -> Maybe v)
-> (k -> map -> Maybe v)
-> (k -> v -> map -> 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
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 []
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 []