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