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

-- | The result of running a Oughta Lua program
module Oughta.Result
  ( Match(..)
  , Progress(..)
  , newProgress
  , updateProgress
  , progressToSuccess
  , Failure(..)
  , Success(..)
  , Result(..)
  , resultNull
  , printResult
  ) where

import Control.Exception qualified as X
import Data.ByteString (ByteString)
import Data.Foldable (toList)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Oughta.Pos (Loc, Span)
import Oughta.Pos qualified as OP
import Oughta.Traceback (Traceback)
import Oughta.Traceback qualified as OT

-- | A successful match of an API call against some text
data Match
  = Match
    { -- | The 'Span' of the match
      Match -> Span
matchSpan :: {-# UNPACK #-} !Span
      -- | The 'Text' that was matched
    , Match -> ByteString
matchText :: !ByteString
      -- | 'Traceback' at the time of the match
    , Match -> Traceback
matchTraceback :: !Traceback
      -- | The rest of the 'Text' after the match
    , Match -> ByteString
matchRemainder :: !ByteString
    }

indent :: Text
indent :: Text
indent = Text
"  "

indentLines :: Text -> Text
indentLines :: Text -> Text
indentLines = [Text] -> Text
Text.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
indent <>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

printMatch :: Match -> Text
printMatch :: Match -> Text
printMatch Match
m =
  [Text] -> Text
Text.unlines
  [ [Text] -> Text
Text.unwords
    [ Text
"✔️ match at"
    , Span -> Text
OP.printSpan (Match -> Span
matchSpan Match
m) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
    ]
  , Text -> Text
indentLines (ByteString -> Text
Text.decodeUtf8Lenient (Match -> ByteString
matchText Match
m))
  , Traceback -> Text
OT.printTraceback (Match -> Traceback
matchTraceback Match
m)
  ]

-- | A sequence of successful matches of API calls against some text
data Progress
 = Progress
   { -- | t'Loc' after the last match
     Progress -> Loc
progressLoc :: {-# UNPACK #-} !Loc
     -- | Successful 'Match'es
   , Progress -> Seq Match
progressMatches :: Seq Match
     -- | Remaining text after the last match
   , Progress -> ByteString
progressRemainder :: !ByteString
   }

printProgress :: Progress -> Text
printProgress :: Progress -> Text
printProgress Progress
p = [Text] -> Text
Text.unlines ((Match -> Text) -> [Match] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Match -> Text
printMatch (Seq Match -> [Match]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Progress -> Seq Match
progressMatches Progress
p)))

-- | Create a new 'Progress' starting at position @'OP.Pos' 1 1@.
newProgress :: FilePath -> ByteString -> Progress
newProgress :: FilePath -> ByteString -> Progress
newProgress FilePath
path ByteString
txt =
  let loc0 :: Loc
loc0 = Maybe FilePath -> Pos -> Loc
OP.Loc (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path) (Int -> Int -> Pos
OP.Pos Int
1 Int
1) in
  Loc -> Seq Match -> ByteString -> Progress
Progress Loc
loc0 Seq Match
forall a. Seq a
Seq.empty ByteString
txt

-- | Update 'Progress' with a new 'Match'
updateProgress :: Match -> Progress -> Progress
updateProgress :: Match -> Progress -> Progress
updateProgress Match
m Progress
p =
  Progress
  { progressLoc :: Loc
progressLoc = (Progress -> Loc
progressLoc Progress
p) { OP.pos = OP.spanEnd (matchSpan m) }
  , progressMatches :: Seq Match
progressMatches = Progress -> Seq Match
progressMatches Progress
p Seq Match -> Match -> Seq Match
forall a. Seq a -> a -> Seq a
Seq.:|> Match
m
  , progressRemainder :: ByteString
progressRemainder = Match -> ByteString
matchRemainder Match
m
  }

-- | Helper, not exported
progressToSuccess :: Progress -> Success
progressToSuccess :: Progress -> Success
progressToSuccess (Progress Loc
loc Seq Match
matches ByteString
remainder) =
  Loc -> Seq Match -> ByteString -> Success
Success Loc
loc Seq Match
matches ByteString
remainder

-- | Failure to match a program against some text.
data Failure
 = Failure
   { Failure -> Progress
failureProgress :: Progress
   , Failure -> Traceback
failureTraceback :: !Traceback
   }

trunc :: Text -> Text
trunc :: Text -> Text
trunc Text
txt =
  let ls :: [Text]
ls = Text -> [Text]
Text.lines Text
txt in
  if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3
  then [Text] -> Text
Text.unlines (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
3 [Text]
ls) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n..."
  else Text
txt

instance Show Failure where
  show :: Failure -> FilePath
show Failure
f =
    Text -> FilePath
Text.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
Text.unlines
      [ Text
""  -- a leading newline makes the output of Tasty more readable
      , Text
"Check failed! Passing checks:"
      , Progress -> Text
printProgress (Failure -> Progress
failureProgress Failure
f)
      , Text
"Failing check:"
      , [Text] -> Text
Text.unwords
        [ Text
"❌ no match at"
        , Loc -> Text
OP.printLoc (Progress -> Loc
progressLoc (Failure -> Progress
failureProgress Failure
f)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
        ]
      , Text -> Text
indentLines (Text -> Text
trunc (ByteString -> Text
Text.decodeUtf8Lenient (Progress -> ByteString
progressRemainder (Failure -> Progress
failureProgress Failure
f))))
      , Traceback -> Text
OT.printTraceback (Failure -> Traceback
failureTraceback Failure
f)
      ]

instance X.Exception Failure

-- | The result of matching a program against some text.
data Success
 = Success
   { -- | t'Loc' after the last match
     Success -> Loc
successLoc :: {-# UNPACK #-} !Loc
     -- | Successful 'Match'es
   , Success -> Seq Match
successMatches :: Seq Match
     -- | Remaining text after the last match
   , Success -> ByteString
successRemainder :: !ByteString
   }

-- | The result of running a Oughta Lua program
newtype Result = Result (Either Failure Success)

-- | Does this 'Rusult' reflect running zero checks?
resultNull :: Result -> Bool
resultNull :: Result -> Bool
resultNull =
  \case
    Result (Left {}) -> Bool
False
    Result (Right Success
s) -> Seq Match -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Success -> Seq Match
successMatches Success
s)

-- | Display a 'Result' in human-readable 'Text'
printResult :: Result -> Text
printResult :: Result -> Text
printResult =
  \case
    Result (Left Failure
f) -> FilePath -> Text
Text.pack (Failure -> FilePath
forall a. Show a => a -> FilePath
show Failure
f)
    Result (Right (Success Loc
loc Seq Match
matches ByteString
remainder)) ->
      Progress -> Text
printProgress (Loc -> Seq Match -> ByteString -> Progress
Progress Loc
loc Seq Match
matches ByteString
remainder)