{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Contains lists of all 'Inspection's and 'Inspection' 'Id's provided by @Stan@.
-}

module Stan.Inspection.All
    ( inspectionsMap
    , inspections
    , inspectionsIds

      -- * Stan inspections search
    , lookupInspectionById
    , getInspectionById
    ) where

import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..), InspectionsMap)
import Stan.Inspection.AntiPattern (antiPatternInspectionsMap)
import Stan.Inspection.Infinite (infiniteInspectionsMap)
import Stan.Inspection.Partial (partialInspectionsMap)
import Stan.Inspection.Style (styleInspectionsMap)

import qualified Data.HashMap.Strict as HM


-- | All 'Inspection's map from 'Id's.
inspectionsMap :: InspectionsMap
inspectionsMap :: InspectionsMap
inspectionsMap =
    InspectionsMap
partialInspectionsMap
    InspectionsMap -> InspectionsMap -> InspectionsMap
forall a. Semigroup a => a -> a -> a
<> InspectionsMap
infiniteInspectionsMap
    InspectionsMap -> InspectionsMap -> InspectionsMap
forall a. Semigroup a => a -> a -> a
<> InspectionsMap
antiPatternInspectionsMap
    InspectionsMap -> InspectionsMap -> InspectionsMap
forall a. Semigroup a => a -> a -> a
<> InspectionsMap
styleInspectionsMap

{- | List of all inspections.
-}
inspections :: [Inspection]
inspections :: [Inspection]
inspections = (Inspection -> Id Inspection) -> [Inspection] -> [Inspection]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Inspection -> Id Inspection
inspectionId ([Inspection] -> [Inspection]) -> [Inspection] -> [Inspection]
forall a b. (a -> b) -> a -> b
$ InspectionsMap -> [Inspection]
forall k v. HashMap k v -> [v]
HM.elems InspectionsMap
inspectionsMap

-- | Set of all inspection 'Id's.
inspectionsIds :: HashSet (Id Inspection)
inspectionsIds :: HashSet (Id Inspection)
inspectionsIds = InspectionsMap -> HashSet (Id Inspection)
forall k a. HashMap k a -> HashSet k
HM.keysSet InspectionsMap
inspectionsMap

-- | Look up 'Inspection' by the given inspection 'Id'.
lookupInspectionById :: Id Inspection -> Maybe Inspection
lookupInspectionById :: Id Inspection -> Maybe Inspection
lookupInspectionById insId :: Id Inspection
insId = Id Inspection -> InspectionsMap -> Maybe Inspection
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Id Inspection
insId InspectionsMap
inspectionsMap
{-# INLINE lookupInspectionById #-}

-- | Get the 'Inspection' by the given known inspection 'Id'.
getInspectionById :: Id Inspection -> Inspection
getInspectionById :: Id Inspection -> Inspection
getInspectionById insId :: Id Inspection
insId = case Id Inspection -> Maybe Inspection
lookupInspectionById Id Inspection
insId of
    Just ins :: Inspection
ins -> Inspection
ins
    Nothing  -> Text -> Inspection
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Inspection) -> Text -> Inspection
forall a b. (a -> b) -> a -> b
$ "Unknown Inspection ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
insId