recollections-0.1.1.0: test-kmettoverse/Kmettoverse.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -ddump-splices #-}

module Main (main) where

import Control.Monad (unless)
import Data.Foldable (traverse_)
import Data.Distributive
import Data.Functor.Rep
import Data.Recollections.TH
import GHC.Generics
import System.Exit (exitFailure)

import qualified Aliased
import qualified Nested.Outer

data Things
  = This
  | That
  | Something
  | Else
  | Entirely
  deriving (Eq, Ord, Show, Enum, Bounded, Generic)

mkCollection ''Things
mkIndices ''Things
mkDistributive ''Things
mkRepresentable ''Things

positions :: Collection (Data.Functor.Rep.Rep Collection)
positions = tabulate id

main :: IO ()
main = do
  putStrLn $ "Representable.tabulate show: " <> show (tabulate @Collection show)
  putStrLn ""
  putStrLn $ "Distributive.distribute: " <> show (distribute [indices])
  putStrLn ""
  putStrLn $ "imapRep: " <> show (imapRep (,) (fmap fromEnum indices))
  putStrLn ""
  traverse_ check $
    [ ("index . indices", all (\t -> index indices t == t) [minBound .. maxBound])
    , ("tabulate id", positions == indices)
    , ("distribute", distribute [indices] == fmap pure indices)
    , ("mzipWithRep", mzipWithRep (+) (fmap fromEnum indices) (pure 1) == fmap (succ . fromEnum) indices)
    , ("fmapRep", fmapRep fromEnum indices == fmap fromEnum indices)
    ] <> Aliased.checks <> Nested.Outer.checks
  where
    check (label, ok) = do
      putStrLn $ label <> ": " <> show ok
      unless ok exitFailure