tests/Utils.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3
   4 module Utils where
   5
   6 import Data.Tree
   7 import Network.URI.Slug
   8 import Relude
   9 import Symantic.Classes (IsoFunctor, ProductFunctor, SumFunctor)
  10
  11 import Webc
  12
  13 usedRoutes :: Layouter a -> [a]
  14 usedRoutes repr = f <$> foldMap flatten (layout repr)
  15   where
  16     f = \case
  17       LayoutNodeSlug a _s -> a
  18
  19 usedSlugs :: Layouter a -> [[Slug]]
  20 usedSlugs repr = f <$> foldMap flatten (layout repr)
  21   where
  22     f = \case
  23       LayoutNodeSlug _a s -> s
  24
  25 {- | Gather symantics used for those tests to instantiate multiple interpreters
  26 on the same quantified 'repr'.
  27 -}
  28 class (IsoFunctor repr, ProductFunctor repr, SumFunctor repr, Slugable repr) => Testable repr
  29
  30 instance (IsoFunctor repr, ProductFunctor repr, SumFunctor repr, Slugable repr) => Testable repr