module Foreign.Hoppy.Generator.Override (
WithOverrides,
plain,
overridden,
unoverriddenValue,
overriddenValues,
MapWithOverrides,
plainMap,
mapWithOverrides,
addOverrideMap,
addOverrideMaps,
applyOverrideMaps,
insertMapOverride,
overriddenMapLookup,
) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
data WithOverrides p v = WithOverrides
{ WithOverrides p v -> v
unoverriddenValue :: v
, WithOverrides p v -> Map p v
overriddenValues :: M.Map p v
}
plain :: v -> WithOverrides p v
plain :: v -> WithOverrides p v
plain v
x = v -> Map p v -> WithOverrides p v
forall p v. v -> Map p v -> WithOverrides p v
WithOverrides v
x Map p v
forall k a. Map k a
M.empty
overridden :: v -> M.Map p v -> WithOverrides p v
overridden :: v -> Map p v -> WithOverrides p v
overridden = v -> Map p v -> WithOverrides p v
forall p v. v -> Map p v -> WithOverrides p v
WithOverrides
getOverride :: Ord p => p -> WithOverrides p v -> v
getOverride :: p -> WithOverrides p v -> v
getOverride p
p WithOverrides p v
o =
v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe (WithOverrides p v -> v
forall p v. WithOverrides p v -> v
unoverriddenValue WithOverrides p v
o) (Maybe v -> v) -> Maybe v -> v
forall a b. (a -> b) -> a -> b
$ p -> Map p v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup p
p (Map p v -> Maybe v) -> Map p v -> Maybe v
forall a b. (a -> b) -> a -> b
$ WithOverrides p v -> Map p v
forall p v. WithOverrides p v -> Map p v
overriddenValues WithOverrides p v
o
addOverride :: Ord p => p -> v -> WithOverrides p v -> WithOverrides p v
addOverride :: p -> v -> WithOverrides p v -> WithOverrides p v
addOverride p
p v
v WithOverrides p v
o = WithOverrides p v
o { overriddenValues :: Map p v
overriddenValues = p -> v -> Map p v -> Map p v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert p
p v
v (Map p v -> Map p v) -> Map p v -> Map p v
forall a b. (a -> b) -> a -> b
$ WithOverrides p v -> Map p v
forall p v. WithOverrides p v -> Map p v
overriddenValues WithOverrides p v
o }
newtype MapWithOverrides p k v =
MapWithOverrides { MapWithOverrides p k v -> Map k (WithOverrides p v)
fromMapWithOverrides :: M.Map k (WithOverrides p v) }
plainMap :: M.Map k v -> MapWithOverrides p k v
plainMap :: Map k v -> MapWithOverrides p k v
plainMap = Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> (Map k v -> Map k (WithOverrides p v))
-> Map k v
-> MapWithOverrides p k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> WithOverrides p v) -> Map k v -> Map k (WithOverrides p v)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map v -> WithOverrides p v
forall v p. v -> WithOverrides p v
plain
mapWithOverrides :: M.Map k (WithOverrides p v) -> MapWithOverrides p k v
mapWithOverrides :: Map k (WithOverrides p v) -> MapWithOverrides p k v
mapWithOverrides = Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides
insertMapOverride ::
(Ord p, Ord k, Show p, Show k)
=> p
-> k
-> v
-> MapWithOverrides p k v
-> MapWithOverrides p k v
insertMapOverride :: p -> k -> v -> MapWithOverrides p k v -> MapWithOverrides p k v
insertMapOverride p
p k
k v
v (MapWithOverrides Map k (WithOverrides p v)
m) =
case k -> Map k (WithOverrides p v) -> Maybe (WithOverrides p v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (WithOverrides p v)
m of
Just WithOverrides p v
_ -> Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v) -> MapWithOverrides p k v
forall a b. (a -> b) -> a -> b
$ (WithOverrides p v -> WithOverrides p v)
-> k -> Map k (WithOverrides p v) -> Map k (WithOverrides p v)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (p -> v -> WithOverrides p v -> WithOverrides p v
forall p v.
Ord p =>
p -> v -> WithOverrides p v -> WithOverrides p v
addOverride p
p v
v) k
k Map k (WithOverrides p v)
m
Maybe (WithOverrides p v)
Nothing ->
[Char] -> MapWithOverrides p k v
forall a. HasCallStack => [Char] -> a
error ([Char] -> MapWithOverrides p k v)
-> [Char] -> MapWithOverrides p k v
forall a b. (a -> b) -> a -> b
$ [Char]
"insertMapOverride: Can't add override for parameter " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ p -> [Char]
forall a. Show a => a -> [Char]
show p
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" under key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ k -> [Char]
forall a. Show a => a -> [Char]
show k
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" that has no default value."
addOverrideMap ::
(Ord p, Ord k, Show p, Show k)
=> p
-> M.Map k v
-> MapWithOverrides p k v
-> MapWithOverrides p k v
addOverrideMap :: p -> Map k v -> MapWithOverrides p k v -> MapWithOverrides p k v
addOverrideMap p
p Map k v
pOverrides (MapWithOverrides Map k (WithOverrides p v)
m) =
Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v) -> MapWithOverrides p k v
forall a b. (a -> b) -> a -> b
$
(k -> v -> Map k (WithOverrides p v) -> Map k (WithOverrides p v))
-> Map k (WithOverrides p v)
-> Map k v
-> Map k (WithOverrides p v)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\k
k v
vOverride Map k (WithOverrides p v)
acc ->
(Maybe (WithOverrides p v) -> Maybe (WithOverrides p v))
-> k -> Map k (WithOverrides p v) -> Map k (WithOverrides p v)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\Maybe (WithOverrides p v)
kOverrides -> case Maybe (WithOverrides p v)
kOverrides of
Just WithOverrides p v
overrides ->
WithOverrides p v -> Maybe (WithOverrides p v)
forall a. a -> Maybe a
Just (WithOverrides p v -> Maybe (WithOverrides p v))
-> WithOverrides p v -> Maybe (WithOverrides p v)
forall a b. (a -> b) -> a -> b
$ p -> v -> WithOverrides p v -> WithOverrides p v
forall p v.
Ord p =>
p -> v -> WithOverrides p v -> WithOverrides p v
addOverride p
p v
vOverride WithOverrides p v
overrides
Maybe (WithOverrides p v)
Nothing ->
[Char] -> Maybe (WithOverrides p v)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (WithOverrides p v))
-> [Char] -> Maybe (WithOverrides p v)
forall a b. (a -> b) -> a -> b
$ [Char]
"addOverrideMap: Parameter " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ p -> [Char]
forall a. Show a => a -> [Char]
show p
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" supplies override for key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ k -> [Char]
forall a. Show a => a -> [Char]
show k
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" that is not in the map of unoverridden values.")
k
k
Map k (WithOverrides p v)
acc)
Map k (WithOverrides p v)
m
Map k v
pOverrides
addOverrideMaps ::
(Ord p, Ord k, Show p, Show k)
=> M.Map p (M.Map k v)
-> MapWithOverrides p k v
-> MapWithOverrides p k v
addOverrideMaps :: Map p (Map k v) -> MapWithOverrides p k v -> MapWithOverrides p k v
addOverrideMaps Map p (Map k v)
overrideMaps (MapWithOverrides Map k (WithOverrides p v)
m) =
Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v) -> MapWithOverrides p k v
forall a b. (a -> b) -> a -> b
$
(p
-> Map k v
-> Map k (WithOverrides p v)
-> Map k (WithOverrides p v))
-> Map k (WithOverrides p v)
-> Map p (Map k v)
-> Map k (WithOverrides p v)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\p
p Map k v
pOverrides ->
MapWithOverrides p k v -> Map k (WithOverrides p v)
forall p k v. MapWithOverrides p k v -> Map k (WithOverrides p v)
fromMapWithOverrides (MapWithOverrides p k v -> Map k (WithOverrides p v))
-> (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v)
-> Map k (WithOverrides p v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Map k v -> MapWithOverrides p k v -> MapWithOverrides p k v
forall p k v.
(Ord p, Ord k, Show p, Show k) =>
p -> Map k v -> MapWithOverrides p k v -> MapWithOverrides p k v
addOverrideMap p
p Map k v
pOverrides (MapWithOverrides p k v -> MapWithOverrides p k v)
-> (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v)
-> MapWithOverrides p k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides)
Map k (WithOverrides p v)
m
Map p (Map k v)
overrideMaps
applyOverrideMaps ::
(Ord p, Ord k, Show p, Show k)
=> M.Map p (M.Map k v)
-> M.Map k v
-> MapWithOverrides p k v
applyOverrideMaps :: Map p (Map k v) -> Map k v -> MapWithOverrides p k v
applyOverrideMaps Map p (Map k v)
overrideMaps Map k v
baseMap =
Map k (WithOverrides p v) -> MapWithOverrides p k v
forall p k v. Map k (WithOverrides p v) -> MapWithOverrides p k v
MapWithOverrides (Map k (WithOverrides p v) -> MapWithOverrides p k v)
-> Map k (WithOverrides p v) -> MapWithOverrides p k v
forall a b. (a -> b) -> a -> b
$
(p
-> Map k v
-> Map k (WithOverrides p v)
-> Map k (WithOverrides p v))
-> Map k (WithOverrides p v)
-> Map p (Map k v)
-> Map k (WithOverrides p v)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\p
p Map k v
pOverrides Map k (WithOverrides p v)
acc ->
(k -> v -> Map k (WithOverrides p v) -> Map k (WithOverrides p v))
-> Map k (WithOverrides p v)
-> Map k v
-> Map k (WithOverrides p v)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\k
k v
vOverride Map k (WithOverrides p v)
acc' ->
(Maybe (WithOverrides p v) -> Maybe (WithOverrides p v))
-> k -> Map k (WithOverrides p v) -> Map k (WithOverrides p v)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\Maybe (WithOverrides p v)
kOverrides -> case Maybe (WithOverrides p v)
kOverrides of
Just WithOverrides p v
overrides ->
WithOverrides p v -> Maybe (WithOverrides p v)
forall a. a -> Maybe a
Just (WithOverrides p v -> Maybe (WithOverrides p v))
-> WithOverrides p v -> Maybe (WithOverrides p v)
forall a b. (a -> b) -> a -> b
$ p -> v -> WithOverrides p v -> WithOverrides p v
forall p v.
Ord p =>
p -> v -> WithOverrides p v -> WithOverrides p v
addOverride p
p v
vOverride WithOverrides p v
overrides
Maybe (WithOverrides p v)
Nothing ->
[Char] -> Maybe (WithOverrides p v)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (WithOverrides p v))
-> [Char] -> Maybe (WithOverrides p v)
forall a b. (a -> b) -> a -> b
$ [Char]
"applyOverrideMaps: Parameter " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ p -> [Char]
forall a. Show a => a -> [Char]
show p
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" supplies override for key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ k -> [Char]
forall a. Show a => a -> [Char]
show k
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" that is not in the map of unoverridden values.")
k
k
Map k (WithOverrides p v)
acc')
Map k (WithOverrides p v)
acc
Map k v
pOverrides)
((v -> WithOverrides p v) -> Map k v -> Map k (WithOverrides p v)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map v -> WithOverrides p v
forall v p. v -> WithOverrides p v
plain Map k v
baseMap)
Map p (Map k v)
overrideMaps
overriddenMapLookup :: (Ord p, Ord k) => p -> k -> MapWithOverrides p k v -> Maybe v
overriddenMapLookup :: p -> k -> MapWithOverrides p k v -> Maybe v
overriddenMapLookup p
p k
k (MapWithOverrides Map k (WithOverrides p v)
x) = p -> WithOverrides p v -> v
forall p v. Ord p => p -> WithOverrides p v -> v
getOverride p
p (WithOverrides p v -> v) -> Maybe (WithOverrides p v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Map k (WithOverrides p v) -> Maybe (WithOverrides p v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (WithOverrides p v)
x