{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Skeletest.Internal.Spec.Output (
  -- * Rendering failures
  renderPrettyFailure,

  -- * BoxSpec
  BoxSpec,
  BoxSpecContent (..),
) where

import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Skeletest.Internal.Paths (readTestFile)
import Skeletest.Internal.Utils.Text (showT)
import UnliftIO.Exception (SomeException, try)

{----- Rendering failures -----}

-- | Render a test failure like:
--
-- @
-- At test/Skeletest/Internal/TestTargetsSpec.hs:19:
-- |
-- |           parseTestTargets input `shouldBe` Right (Just expected)
-- |                                   ^^^^^^^^
--
-- Right 1 ≠ Left 1
-- @
renderPrettyFailure ::
  -- | Message
  Text ->
  -- | Failure context
  [Text] ->
  -- | Call stack (file, line, startCol, endCol)
  [(FilePath, Int, Int, Int)] ->
  IO Text
renderPrettyFailure :: Text -> [Text] -> [(FilePath, Int, Int, Int)] -> IO Text
renderPrettyFailure Text
msg [Text]
ctx [(FilePath, Int, Int, Int)]
callstack = do
  [Text]
prettyStackTrace <- ((FilePath, Int, Int, Int) -> IO Text)
-> [(FilePath, Int, Int, Int)] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath, Int, Int, Int) -> IO Text
renderCallLine ([(FilePath, Int, Int, Int)] -> IO [Text])
-> ([(FilePath, Int, Int, Int)] -> [(FilePath, Int, Int, Int)])
-> [(FilePath, Int, Int, Int)]
-> IO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Int, Int, Int)] -> [(FilePath, Int, Int, Int)]
forall a. [a] -> [a]
reverse ([(FilePath, Int, Int, Int)] -> IO [Text])
-> [(FilePath, Int, Int, Int)] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [(FilePath, Int, Int, Int)]
callstack
  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> ([[Text]] -> Text) -> [[Text]] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n\n" ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> IO Text) -> [[Text]] -> IO Text
forall a b. (a -> b) -> a -> b
$
    [ [Text]
prettyStackTrace
    , if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ctx
        then []
        else [Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ctx]
    , [Text
msg]
    ]
 where
  renderCallLine :: (FilePath, Int, Int, Int) -> IO Text
renderCallLine (FilePath
path, Int
lineNum, Int
startCol, Int
endCol) = do
    Either FilePath Text
mLine <-
      IO Text -> IO (Either SomeException Text)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (FilePath -> IO Text
readTestFile FilePath
path) IO (Either SomeException Text)
-> (Either SomeException Text -> IO (Either FilePath Text))
-> IO (Either FilePath Text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Text
srcFile
          | Just Text
line <- Int -> Text -> Maybe Text
getLineNum Int
lineNum Text
srcFile -> Either FilePath Text -> IO (Either FilePath Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Text -> IO (Either FilePath Text))
-> Either FilePath Text -> IO (Either FilePath Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either FilePath Text
forall a b. b -> Either a b
Right Text
line
          | Bool
otherwise -> Either FilePath Text -> IO (Either FilePath Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Text -> IO (Either FilePath Text))
-> Either FilePath Text -> IO (Either FilePath Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Text
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Text)
-> FilePath -> Either FilePath Text
forall a b. (a -> b) -> a -> b
$ FilePath
"<line does not exist: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
":" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lineNum FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
">"
        Left (SomeException
_ :: SomeException) -> Either FilePath Text -> IO (Either FilePath Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Text -> IO (Either FilePath Text))
-> Either FilePath Text -> IO (Either FilePath Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Text
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Text)
-> FilePath -> Either FilePath Text
forall a b. (a -> b) -> a -> b
$ FilePath
"<could not open file: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
">"
    let (Text
srcLine, Text
pointerLine) =
          case Either FilePath Text
mLine of
            Right Text
line ->
              ( Text
line
              , Int -> Text -> Text
Text.replicate (Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate (Int
endCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startCol) Text
"^"
              )
            Left FilePath
e -> (FilePath -> Text
Text.pack FilePath
e, Text
"")

    Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> ([Text] -> Text) -> [Text] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> IO Text) -> [Text] -> IO Text
forall a b. (a -> b) -> a -> b
$
      [ FilePath -> Text
Text.pack FilePath
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
lineNum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
      , Text
"│"
      , Text
"│ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srcLine
      , Text
"│ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pointerLine
      ]

  getLineNum :: Int -> Text -> Maybe Text
getLineNum Int
n = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

{----- BoxSpec -----}

-- | The specification for boxed output.
type BoxSpec = [BoxSpecContent]

data BoxSpecContent
  = BoxText Text
  | BoxHeader Text
  deriving (Int -> BoxSpecContent -> FilePath -> FilePath
[BoxSpecContent] -> FilePath -> FilePath
BoxSpecContent -> FilePath
(Int -> BoxSpecContent -> FilePath -> FilePath)
-> (BoxSpecContent -> FilePath)
-> ([BoxSpecContent] -> FilePath -> FilePath)
-> Show BoxSpecContent
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> BoxSpecContent -> FilePath -> FilePath
showsPrec :: Int -> BoxSpecContent -> FilePath -> FilePath
$cshow :: BoxSpecContent -> FilePath
show :: BoxSpecContent -> FilePath
$cshowList :: [BoxSpecContent] -> FilePath -> FilePath
showList :: [BoxSpecContent] -> FilePath -> FilePath
Show, BoxSpecContent -> BoxSpecContent -> Bool
(BoxSpecContent -> BoxSpecContent -> Bool)
-> (BoxSpecContent -> BoxSpecContent -> Bool) -> Eq BoxSpecContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxSpecContent -> BoxSpecContent -> Bool
== :: BoxSpecContent -> BoxSpecContent -> Bool
$c/= :: BoxSpecContent -> BoxSpecContent -> Bool
/= :: BoxSpecContent -> BoxSpecContent -> Bool
Eq)