{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Krank.Formatter
  ( showViolation,
  )
where

import Data.Text (Text)
import Krank.Types
import PyF (fmt)
import System.Console.Pretty
import Utils.Display (indent)

showViolation ::
  Bool ->
  Violation ->
  Text
showViolation :: Bool -> Violation -> Text
showViolation Bool
useColors Violation {Text
checker :: Violation -> Text
checker :: Text
checker, SourcePos
location :: Violation -> SourcePos
location :: SourcePos
location, ViolationLevel
level :: Violation -> ViolationLevel
level :: ViolationLevel
level, Text
message :: Violation -> Text
message :: Text
message} =
  [fmt|
{showSourcePos location}: {showViolationLevel useColors level}:
{indent 2 checker}
{indent 4 message}
|]

showViolationLevel :: Bool -> ViolationLevel -> String
showViolationLevel :: Bool -> ViolationLevel -> String
showViolationLevel Bool
enableColor = \case
  ViolationLevel
Info -> forall {c}. Pretty c => Color -> c -> c
colorized Color
Green String
"info"
  ViolationLevel
Warning -> forall {c}. Pretty c => Color -> c -> c
colorized Color
Magenta String
"warning"
  ViolationLevel
Error -> forall {c}. Pretty c => Color -> c -> c
colorized Color
Red String
"error"
  where
    colorized :: Color -> c -> c
colorized Color
c
      | Bool
enableColor = forall a. Pretty a => Style -> a -> a
style Style
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. Pretty c => Color -> c -> c
color Color
c
      | Bool
otherwise = forall a. a -> a
id

showSourcePos :: SourcePos -> String
showSourcePos :: SourcePos -> String
showSourcePos (SourcePos String
path Int
line Int
column) = [fmt|{path}:{line}:{column}|]