data-forest-0.1.0.11: test/Main.hs

module Main (main) where

import Control.Applicative (Applicative (pure, (<*>)), (<$>))
import Control.Monad (Functor (fmap), Monad (return, (>>=)))
import Data.Bool (Bool, (&&))
import Data.Char (Char, toUpper)
import Data.Eq (Eq ((==)))
import Data.Foldable (Foldable (null, toList))
import Data.Forest
  ( Forest (..),
    Tree (..),
    foldForest,
    foldTree,
    forest,
    leaf,
    leaves,
    tree,
  )
import Data.Function (($), (.))
import Data.List (intercalate, map)
import Data.Semigroup (Semigroup ((<>)))
import Numeric.Natural (Natural)
import System.Exit (die)
import System.IO (IO, putStrLn)
import Text.Show (Show (show))

main :: IO ()
main = dieIfFailures $ do
  test 1 $
    let example :: Forest Char
        example =
          forest
            [ tree 'a' $ leaves "bc",
              tree 'd' $
                forest
                  [ leaf 'e',
                    tree 'f' $ leaves "g"
                  ]
            ]
     in foldForest
          ( intercalate ", "
              . fmap (\(a, b) -> [a] <> " [" <> b <> "]")
          )
          example
          == "a [b [], c []], d [e [], f [g []]]"

  test 2 $
    let example :: Tree Char
        example =
          tree 'a' $
            forest
              [ tree 'b' $ leaves "cd",
                tree 'e' $
                  forest
                    [ leaf 'f',
                      tree 'g' $ leaves "h"
                    ]
              ]
     in foldTree
          ( \a bs ->
              [a] <> " [" <> intercalate ", " bs <> "]"
          )
          example
          == "a [b [c [], d []], e [f [], g [h []]]]"

  test 3 $
    let example :: Forest Char
        example =
          forest
            [ tree 'a' $ leaves "bc",
              tree 'd' $
                forest
                  [ leaf 'e',
                    tree 'f' $ leaves "g"
                  ]
            ]
        showCharForest f =
          intercalate ", " (showCharTree <$> trees f)
          where
            showCharTree t = case trees (subforest t) of
              [] -> [root t]
              [t'] -> [root t] <> ": " <> showCharTree t'
              _ -> [root t] <> ": (" <> showCharForest (subforest t) <> ")"
     in showCharForest example
          == "a: (b, c), d: (e, f: g)"
          && showCharForest (fmap toUpper example)
            == "A: (B, C), D: (E, F: G)"

  test 4 $
    let example :: Forest Char
        example =
          forest
            [ tree 'a' $ leaves "bc",
              tree 'd' $
                forest
                  [ leaf 'e',
                    tree 'f' $ leaves "g"
                  ]
            ]
     in toList example == "abcdefg"

dieIfFailures :: Failures a -> IO a
dieIfFailures (Failures fs x) =
  if null fs
    then do putStrLn "💯"; return x
    else die $ intercalate " " (map (("🔥" <>) . show) fs)

type TestNumber = Natural

test :: TestNumber -> Bool -> Failures ()
test n t = Failures (if t then [] else [n]) ()

data Failures a = Failures [TestNumber] a

instance Functor Failures where
  fmap f (Failures a x) = Failures a (f x)

instance Applicative Failures where
  pure x = Failures [] x
  Failures a f <*> Failures b x = Failures (a <> b) (f x)

instance Monad Failures where
  Failures a x >>= f = let Failures b y = f x in Failures (a <> b) y