caliper-0.1.0.0: test/Main.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import Data.TreeDiff
import Data.TreeDiff.Golden
import Data.TreeDiff.Instances.Caliper ()
import Data.Void
import System.FilePath
import Test.Tasty
import Test.Tasty.Golden.Advanced

import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.Time.LocalTime
import Text.Megaparsec

import Caliper.Cli
import Caliper.Syntax

main :: IO ()
main = defaultMain tests

type ParseResult = Either (ParseErrorBundle T.Text Void)

tests :: TestTree
tests =
  testGroup
    "Tests"
    [ parserTests
    , resolutionTests
    , queryTests
    , histogramTests
    ]

parserTests :: TestTree
parserTests =
  testGroup
    "Parser"
    [ parserTestOk "ok_001" "ok_001.clp"
    , parserTestOk "ok_002" "ok_002.clp"
    , parserTestOk "ok_003" "ok_003.clp"
    , parserTestOk "ok_004" "ok_004.clp"
    , parserTestOk "ok_005" "ok_005.clp"
    , parserTestOk "ok_006" "ok_006.clp"
    , parserTestOk "ok_007" "ok_007.clp"
    , parserTestOk "ok_008" "ok_008.clp"
    , parserTestOk "ok_009" "ok_009.clp"
    , parserTestOk "ok_010" "ok_010.clp"
    , parserTestOk "ok_012" "ok_012.clp"
    , rawParserTestErr "err_003" "err_003.clp"
    , rawParserTestErr "err_005" "err_005.clp"
    , parserTestOk "ok_013" "ok_013.clp"
    , parserTestOk "ok_014" "ok_014.clp"
    , rawParserTestOk "ok_014_raw" "ok_014.clp"
    , parserTestOk "ok_015" "ok_015.clp"
    ]

-- Doesn't resolve
rawParserTestOk :: String -> FilePath -> TestTree
rawParserTestOk name fp = mkGoldenTestOk (\_src -> pure) name ("parser" </> fp)

rawParserTestErr :: String -> FilePath -> TestTree
rawParserTestErr name fp = mkGoldenTestErr name ("parser" </> fp)

-- Resolves
parserTestOk :: String -> FilePath -> TestTree
parserTestOk name fp = mkGoldenTestOk (\_src -> pure . resolve) name ("parser" </> fp)

resolutionTests :: TestTree
resolutionTests =
  testGroup
    "Resolution"
    [ resolveTestErr "err_001" "err_001.clp"
    , resolveTestErr "err_002" "err_002.clp"
    , resolveTestErr "err_004" "err_004.clp"
    ]

-- Parses but shouldn't resolve because of semantic errors
resolveTestErr :: String -> FilePath -> TestTree
resolveTestErr name fp = mkGoldenTestOk resolveShouldError name ("parser" </> fp)
  where
    resolveShouldError :: T.Text -> RawAst -> IO T.Text
    resolveShouldError src (resolve -> (errs, _)) = pure $ mconcat $ map (resolutionErrorPretty src) errs

histogramTests :: TestTree
histogramTests =
  testGroup
    "histogram"
    [ histogramTest groupEntriesByDay "001_groupByDay" "001.clp"
    , histogramTest (fmap histogramLine . groupEntriesByDay) "001_groupByDay_cli" "001.clp"
    ]

histogramTest
  :: ToExpr expr
  => ([ResolvedEntry] -> expr)
  -> String
  -> FilePath
  -> TestTree
histogramTest f name fp = mkGoldenTestOk (\_src -> pure . fmap f . resolve) name ("histogram" </> fp)

queryTests :: TestTree
queryTests =
  testGroup
    "Query"
    [ queryTest [HasKeyValue "foo" "bar"] "001_foobar" "001.clp"
    , queryTest [Negate $ HasKeyValue "foo" "bar"] "001_notfoobar" "001.clp"
    , beforeFilterTest (read "2025-10-02 22:59:06") "001_before_complete" "001.clp"
    , beforeFilterTest (read "2025-10-02 22:59:55") "001_before_truncate" "001.clp"
    , afterFilterTest (read "2025-10-02 22:59:06") "001_after_complete" "001.clp"
    , afterFilterTest (read "2025-10-02 22:59:55") "001_after_truncate" "001.clp"
    , beforeFilterTest (read "2025-10-02 22:59:06") "002_before_complete" "002.clp"
    , beforeFilterTest (read "2025-10-02 22:59:55") "002_before_truncate" "002.clp"
    , afterFilterTest (read "2025-10-02 22:59:06") "002_after_complete" "002.clp"
    , afterFilterTest (read "2025-10-02 22:59:55") "002_after_truncate" "002.clp"
    ]

queryTest :: [TagPredicate] -> String -> FilePath -> TestTree
queryTest filters name fp =
  mkGoldenTestOk
    (\_src -> pure . fmap (filterByTags filters) . resolve)
    name
    ("query" </> fp)

beforeFilterTest :: LocalTime -> String -> FilePath -> TestTree
beforeFilterTest thres name fp =
  mkGoldenTestOk
    (\_src -> pure . fmap (entriesBefore thres) . resolve)
    name
    ("query" </> fp)

afterFilterTest :: LocalTime -> String -> FilePath -> TestTree
afterFilterTest thres name fp =
  mkGoldenTestOk
    (\_src -> pure . fmap (entriesAfter thres) . resolve)
    name
    ("query" </> fp)

parsedRight :: IO (ParseResult a) -> IO a
parsedRight x =
  x >>= \case
    Left err -> fail $ errorBundlePretty err
    Right ok -> pure ok

mkGoldenTestOk
  :: ToExpr expr
  => (T.Text -> RawAst -> IO expr)
  -> String
  -> FilePath
  -> TestTree
mkGoldenTestOk f = mkGoldenTest $ \src -> \case
  Right output -> do
    output' <- f src output
    pure $ toExpr output'
  Left err -> fail $ errorBundlePretty err

mkGoldenTestErr :: String -> FilePath -> TestTree
mkGoldenTestErr = mkGoldenTest $ \_src -> \case
  Right output -> fail $ "Unexpected success:\n" <> show output
  Left err -> pure $ errorBundlePretty err

mkGoldenTest
  :: (Eq expr, ToExpr expr)
  => ( forall s e
        . (VisualStream s, TraversableStream s, ShowErrorComponent e)
       => T.Text
       -> Either (ParseErrorBundle s e) RawAst
       -> IO expr
     )
  -- ^ handle the parse result
  -> String
  -> FilePath
  -> TestTree
mkGoldenTest f name fname =
  ediffGolden goldenTest name outFilePath $ do
    content <- TIO.readFile inFilePath
    f content $ runParser caliperAst inFilePath content
  where
    inFilePath = "test" </> "data" </> fname
    outFilePath = inFilePath `replaceFileName` name `addExtension` ".expr"