{-# 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.Text ( Text )
import qualified Data.Text as T
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 [] = forall a. Monoid a => a
mempty
sweetsKVITable [Sweets]
sweets =
  let t :: KVITable FilePath
t = forall v. [Item (KVITable v)] -> KVITable v
fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\Sweets
s ->
              [
                ( (Text
"base", FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Sweets -> FilePath
rootBaseName Sweets
s)
                  forall a. a -> [a] -> [a]
: (Text
"rootFile", FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Sweets -> FilePath
rootFile Sweets
s)
                  forall a. a -> [a] -> [a]
: [ (FilePath -> Text
T.pack FilePath
pn, FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
PP.pretty ParamMatch
pv)
                    | (FilePath
pn,ParamMatch
pv) <- Expectation -> [(FilePath, ParamMatch)]
expParamsMatch Expectation
e ]
                  forall a. Semigroup a => a -> a -> a
<> [ (FilePath -> Text
T.pack FilePath
an, FilePath -> Text
T.pack 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 forall a b. a -> (a -> b) -> b
& forall v. Lens' (KVITable v) Text
valueColName forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Expected File"

-- | Converts a set of discovered Sweets directly into a text-based table for
-- shoing 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 :: [Text]
rowGroup = Text
"base"
                         forall a. a -> [a] -> [a]
: Text
"rootFile"
                         forall a. a -> [a] -> [a]
: (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take Int
1 (CUBE -> [(FilePath, Maybe [FilePath])]
validParams forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [CUBE]
c))
            , rowRepeat :: Bool
rowRepeat = Bool
False
            }
  in forall v. Pretty v => RenderConfig -> KVITable v -> Text
render RenderConfig
cfg forall a b. (a -> b) -> a -> b
$ [Sweets] -> KVITable FilePath
sweetsKVITable [Sweets]
s