Problem.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}

module Descript.Misc.Build.Process.Validate.Problem
  ( Problem (..)
  , validateErrorSummary
  ) where

import Descript.Misc.Build.Process.Validate.Term (Term)
import Descript.Misc.Build.Read.File
import Descript.Misc.Ann
import Descript.Misc.Summary
import Data.List
import Core.Data.String

-- | A reason why code isn't valid / well-formed.
-- Not called "error" because errors typically occur during an operation
-- (e.g. parsing), preventing the operation, but in 'Validate', finding
-- problems /is/ the operation (validation errors /will/ prevent
-- interpretation, so there's a 'ValidateError' for building).
data Problem an
  = ProblemDepFail (TagdDepError an)
  | Conflict an Term String
  | Duplicate an Term String
  | UndeclaredRecord an String
  | IncompleteRecord an [String]
  | OvercompleteRecord an [String]
  | UndeclaredPathElemHead an String
  | UndeclaredPathElemKey an String
  | UndefinedInjFunc an String
  | WrongInjFuncParamsLen an Int Int
  | WrongInjFuncParamType an String String
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

instance Ann Problem where
  getAnn (ProblemDepFail derr) = getAnn derr
  getAnn (Conflict ann _ _) = ann
  getAnn (Duplicate ann _ _) = ann
  getAnn (UndeclaredRecord ann _) = ann
  getAnn (IncompleteRecord ann  _) = ann
  getAnn (OvercompleteRecord ann _) = ann
  getAnn (UndeclaredPathElemHead ann _) = ann
  getAnn (UndeclaredPathElemKey ann _) = ann
  getAnn (UndefinedInjFunc ann _) = ann
  getAnn (WrongInjFuncParamsLen ann _ _) = ann
  getAnn (WrongInjFuncParamType ann _ _) = ann

instance SummaryWithAnn Problem where
  baseSummary (ProblemDepFail derr)
    = "failed to load dependency:\n" ++ baseSummary derr
  baseSummary (Conflict _ term valPr)
    = termSum ++ " conflicts with an earlier " ++ termSum ++ ": " ++ valPr
    where termSum = summary term
  baseSummary (Duplicate _ term valPr)
    = "duplicate " ++ summary term ++ ": " ++ valPr
  baseSummary (UndeclaredRecord _ symPr)
    = "undeclared record type: " ++ symPr
  baseSummary (IncompleteRecord _ missingKeyPrs)
    = "incomplete record: missing " ++ intercalate ", " missingKeyPrs
  baseSummary (OvercompleteRecord _ extraKeyPrs)
    = "record has extra, undeclared properties: " ++ intercalate ", " extraKeyPrs
  baseSummary (UndeclaredPathElemHead _ headPr)
    = "nonexistent path: head not in input: " ++ headPr
  baseSummary (UndeclaredPathElemKey _ keyPr)
    = "nonexistent path: key not in record: " ++ keyPr
  baseSummary (UndefinedInjFunc _ funcPr)
    = "undefined injected function: " ++ funcPr
  baseSummary (WrongInjFuncParamsLen _ expected actual)
     = "wrong number of parameters given to injected function: expected "
    ++ show expected ++ ", given " ++ show actual
  baseSummary (WrongInjFuncParamType _ expectedPr actualPr)
    = "wrong type of parameter given to injected function: expected "
   ++ expectedPr ++ ", given " ++ actualPr

instance (AnnSummary an) => Summary (Problem an) where
  summary = summaryWithAnn

-- | Summarizes a validation error in a larger context (e.g. build
-- error).
validateErrorSummary :: (AnnSummary an) => [Problem an] -> String
validateErrorSummary probs = "invalid:" ++ probsSummary
  where probsSummary = concatMap probSummary probs

probSummary :: (Summary a) => a -> String
probSummary sub = '\n' : indentBullet (summary sub)