{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Validity.Map
  ( decorateMap
  ) where

import Data.Map (Map)
import qualified Data.Map as M
import Data.Validity

-- | A 'Map' of things is valid if all the keys and values are valid and the 'Map' itself
-- is valid.
instance (Show k, Ord k, Validity k, Validity v) => Validity (Map k v) where
  validate :: Map k v -> Validation
validate Map k v
m =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Bool -> Validation
declare String
"The Map structure is valid." (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Map k v -> Bool
forall k a. Ord k => Map k a -> Bool
M.valid Map k v
m
      , String -> Validation -> Validation
decorate String
"Map elements" (Validation -> Validation) -> Validation -> Validation
forall a b. (a -> b) -> a -> b
$
        Map k v -> (k -> v -> Validation) -> Validation
forall k v.
Show k =>
Map k v -> (k -> v -> Validation) -> Validation
decorateMap Map k v
m ((k -> v -> Validation) -> Validation)
-> (k -> v -> Validation) -> Validation
forall a b. (a -> b) -> a -> b
$ \k
k v
v -> [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat [String -> k -> Validation
forall a. Validity a => String -> a -> Validation
delve String
"The key" k
k, String -> v -> Validation
forall a. Validity a => String -> a -> Validation
delve String
"The value" v
v]
      ]

decorateMap :: Show k => Map k v -> (k -> v -> Validation) -> Validation
decorateMap :: forall k v.
Show k =>
Map k v -> (k -> v -> Validation) -> Validation
decorateMap Map k v
m k -> v -> Validation
func = (k -> v -> Validation) -> Map k v -> Validation
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey k -> v -> Validation
go Map k v
m
  where
    go :: k -> v -> Validation
go k
k v
v = String -> Validation -> Validation
decorate (String
"The key/value at key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Show a => a -> String
show k
k) (Validation -> Validation) -> Validation -> Validation
forall a b. (a -> b) -> a -> b
$ k -> v -> Validation
func k
k v
v