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

module Data.Validity.IntMap
  ( decorateIntMap,
  )
where

import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.Validity

-- | A 'IntMap' of things is valid if all the keys and values are valid and the 'IntMap' itself
-- is valid.
instance (Validity v) => Validity (IntMap v) where
  validate :: IntMap v -> Validation
validate IntMap v
m =
    String -> Validation -> Validation
decorate String
"IntMap elements" (Validation -> Validation) -> Validation -> Validation
forall a b. (a -> b) -> a -> b
$
      IntMap v -> (v -> Validation) -> Validation
forall v. IntMap v -> (v -> Validation) -> Validation
decorateIntMap IntMap v
m v -> Validation
forall a. Validity a => a -> Validation
validate

decorateIntMap :: IntMap v -> (v -> Validation) -> Validation
decorateIntMap :: forall v. IntMap v -> (v -> Validation) -> Validation
decorateIntMap IntMap v
m v -> Validation
func = (Key -> v -> Validation) -> IntMap v -> Validation
forall m a. Monoid m => (Key -> a -> m) -> IntMap a -> m
IM.foldMapWithKey Key -> v -> Validation
forall {a}. Show a => a -> v -> Validation
go IntMap v
m
  where
    go :: a -> v -> Validation
go a
k v
v = String -> Validation -> Validation
decorate (String
"The key/value at key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k) (Validation -> Validation) -> Validation -> Validation
forall a b. (a -> b) -> a -> b
$ v -> Validation
func v
v