{-# LANGUAGE OverloadedStrings #-}

-- | Generate user-consumable reports regarding the findings of tasty-sugar.

module Test.Tasty.Sugar.Report
  (
    sweetsKVITable
  , sweetsTextTable
  )
  where

import           Data.KVITable
import           Data.KVITable.Render.ASCII ( render
                                            , defaultRenderConfig
                                            , RenderConfig(..) )
import           Data.String ( fromString )
import           Data.Text ( Text )
import           Lens.Micro ( (&), (.~) )
import qualified Prettyprinter as PP
import           System.FilePath ( takeFileName )

import           Test.Tasty.Sugar.Types


-- | Converts a set of discovered Sweets into a KVITable; this is usually done in
-- order to render the KVITable in a readable format.
sweetsKVITable :: [Sweets] -> KVITable FilePath
sweetsKVITable :: [Sweets] -> KVITable FilePath
sweetsKVITable [] = KVITable FilePath
forall a. Monoid a => a
mempty
sweetsKVITable [Sweets]
sweets =
  let t :: KVITable FilePath
t = [Item (KVITable FilePath)] -> KVITable FilePath
forall v. [Item (KVITable v)] -> KVITable v
fromList ([Item (KVITable FilePath)] -> KVITable FilePath)
-> [Item (KVITable FilePath)] -> KVITable FilePath
forall a b. (a -> b) -> a -> b
$ (Sweets -> [([(Key, KeyVal)], FilePath)])
-> [Sweets] -> [([(Key, KeyVal)], FilePath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\Sweets
s ->
              [
                ( (Key
"base", FilePath -> KeyVal
forall a. IsString a => FilePath -> a
fromString (FilePath -> KeyVal) -> FilePath -> KeyVal
forall a b. (a -> b) -> a -> b
$ Sweets -> FilePath
rootBaseName Sweets
s)
                  (Key, KeyVal) -> [(Key, KeyVal)] -> [(Key, KeyVal)]
forall a. a -> [a] -> [a]
: (Key
"rootFile", FilePath -> KeyVal
forall a. IsString a => FilePath -> a
fromString (FilePath -> KeyVal) -> FilePath -> KeyVal
forall a b. (a -> b) -> a -> b
$ Sweets -> FilePath
rootFile Sweets
s)
                  (Key, KeyVal) -> [(Key, KeyVal)] -> [(Key, KeyVal)]
forall a. a -> [a] -> [a]
: [ (FilePath -> Key
forall a. IsString a => FilePath -> a
fromString FilePath
pn, FilePath -> KeyVal
forall a. IsString a => FilePath -> a
fromString (FilePath -> KeyVal) -> FilePath -> KeyVal
forall a b. (a -> b) -> a -> b
$ Doc Any -> FilePath
forall a. Show a => a -> FilePath
show (Doc Any -> FilePath) -> Doc Any -> FilePath
forall a b. (a -> b) -> a -> b
$ ParamMatch -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. ParamMatch -> Doc ann
PP.pretty ParamMatch
pv)
                    | (FilePath
pn,ParamMatch
pv) <- Expectation -> [(FilePath, ParamMatch)]
expParamsMatch Expectation
e ]
                  [(Key, KeyVal)] -> [(Key, KeyVal)] -> [(Key, KeyVal)]
forall a. Semigroup a => a -> a -> a
<> [ (FilePath -> Key
forall a. IsString a => FilePath -> a
fromString FilePath
an, FilePath -> KeyVal
forall a. IsString a => FilePath -> a
fromString (FilePath -> KeyVal) -> FilePath -> KeyVal
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
af)
                     | (FilePath
an,FilePath
af) <- Expectation -> [(FilePath, FilePath)]
associated Expectation
e ]
                , FilePath -> FilePath
takeFileName (Expectation -> FilePath
expectedFile Expectation
e)
                )
              | Expectation
e <- Sweets -> [Expectation]
expected Sweets
s
              ])
          [Sweets]
sweets
  in KVITable FilePath
t KVITable FilePath
-> (KVITable FilePath -> KVITable FilePath) -> KVITable FilePath
forall a b. a -> (a -> b) -> b
& (Named HTMLStyle "column header"
 -> Identity (Named HTMLStyle "column header"))
-> KVITable FilePath -> Identity (KVITable FilePath)
forall v (f :: * -> *).
Functor f =>
(Named HTMLStyle "column header"
 -> f (Named HTMLStyle "column header"))
-> KVITable v -> f (KVITable v)
valueColName ((Named HTMLStyle "column header"
  -> Identity (Named HTMLStyle "column header"))
 -> KVITable FilePath -> Identity (KVITable FilePath))
-> Named HTMLStyle "column header"
-> KVITable FilePath
-> KVITable FilePath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Named HTMLStyle "column header"
"Expected File"

-- | Converts a set of discovered Sweets directly into a text-based table for
-- showing to the user.
sweetsTextTable :: [CUBE] -> [Sweets] -> Text
sweetsTextTable :: [CUBE] -> [Sweets] -> Text
sweetsTextTable [] [Sweets]
_ = Text
"No CUBE provided for report"
sweetsTextTable [CUBE]
_ [] = Text
"No Sweets provided for report"
sweetsTextTable [CUBE]
c [Sweets]
s =
  let cfg :: RenderConfig
cfg = RenderConfig
defaultRenderConfig
            { rowGroup = "base"
                         : "rootFile"
                         : (fromString . fst <$> take 1 (validParams $ head c))
            , rowRepeat = False
            }
  in RenderConfig -> KVITable FilePath -> Text
forall v. Sayable "normal" v => RenderConfig -> KVITable v -> Text
render RenderConfig
cfg (KVITable FilePath -> Text) -> KVITable FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [Sweets] -> KVITable FilePath
sweetsKVITable [Sweets]
s