--- /dev/null
+dist-newstyle
+classgraph-demo.html
+examples/demo/.classgraph
\ No newline at end of file
Demo.OpenFamily
Demo.ClosedFamily
Demo.Orphan
+ Demo.Greetings
+ Demo.Equality
+ Demo.MoreFamilies
build-depends: base ^>=4.22
, classgraph
ghc-options: -Wall
--- /dev/null
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | Exercises the type-equality predicate path: an instance whose
+-- context contains @a ~ b@. The viewer should:
+--
+-- * Render this in the side panel as @a ~ b@ (infix), not as
+-- @~ a b@ (a fake class application).
+-- * Surface the equality as a chip on the instance node in the
+-- graph rather than as an edge to a synthetic class.
+module Demo.Equality where
+
+import Demo.Basic (Pretty (..))
+import Demo.OpenFamily (Norm)
+
+-- A class indexed by two types.
+class TwoSame a b where
+ asSame :: a -> b
+
+-- An instance that only fires when the two indices are the same type.
+-- The constraint @a ~ b@ stays in the dictionary's theta after
+-- type-checking, so the viewer sees an EqPred.
+instance (a ~ b, Pretty a) => TwoSame a b where
+ asSame x = x
+
+-- An equality constraint that *also* contains a type-family application —
+-- exercises both features together: @Norm a ~ Int@ keeps the family
+-- mention visible while the chip renders the equality.
+class NormalisesToInt a where
+ toInt :: a -> Int
+
+instance (Norm a ~ Int, Pretty a) => NormalisesToInt a where
+ toInt _ = 0
--- /dev/null
+-- | A class with eight instances so the per-instance visibility filter,
+-- "Show all" / "Hide all" buttons, and substring filter input all have
+-- something to chew on.
+module Demo.Greetings where
+
+class Greeting a where
+ greet :: a -> String
+
+instance Greeting Int where greet n = "int " <> show n
+instance Greeting Bool where greet True = "yes"
+ greet False = "no"
+instance Greeting Char where greet c = ['\'', c, '\'']
+instance Greeting Integer where greet n = "integer " <> show n
+instance Greeting Double where greet n = "double " <> show n
+instance Greeting Float where greet n = "float " <> show n
+instance Greeting () where greet _ = "unit"
+instance Greeting Ordering where greet o = case o of LT -> "lt"
+ EQ -> "eq"
+ GT -> "gt"
--- /dev/null
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | A class whose /instance contexts/ (not its superclass theta)
+-- reference a type-family application. The viewer's instance view
+-- should attach a "via family" edge from the instance node to the
+-- @Bag@ family node, plus surface every known @type instance Bag …@
+-- row underneath.
+module Demo.MoreFamilies where
+
+import Demo.Basic (Pretty (..))
+
+-- An open type family whose instances live a few lines below this
+-- declaration. The viewer's family view should list both rows.
+type family Bag a
+
+class Boxable a where
+ box :: a -> Bag a
+
+-- The context @Pretty (Bag a)@ mentions @Bag@ inside a class
+-- predicate. With the new family-association feature, the instance
+-- view of @Boxable@ should draw an edge to the @Bag@ family node and
+-- pull in the type-instance rows.
+instance Pretty (Bag a) => Boxable a where
+ box _ = error "demo: Boxable Bag is unimplemented"
+
+-- Concrete family equations.
+type instance Bag Int = [Int]
+type instance Bag Bool = String
+
+-- A second class that depends on @Bag@'s output via a constraint
+-- referencing it indirectly.
+class HasBaggedInfo a where
+ baggedInfo :: a -> String
+
+instance Pretty (Bag a) => HasBaggedInfo a where
+ baggedInfo _ = "bagged"
instance Pretty' Int where
pretty' = show
+
+-- A boxed value, used below to give HasDefault some instances. Picking a
+-- two-parameter datatype so the multi-param edge labelling is visible.
+data Box v = Box v
+
+-- HasDefault instances — populates the previously empty class so the
+-- multi-param positional mapping (`v`) shows up in the *instance* view as
+-- well as the classes view, and Pretty' v context appears as a
+-- context-edge to the Pretty' class.
+instance Pretty' v => HasDefault (Box v) v where
+ defaultValue (Box v) = v
+
+instance HasDefault (Maybe Int) Int where
+ defaultValue (Just n) = n
+ defaultValue Nothing = 0
+
+-- A multi-param Indexed instance; the superclass edge `Indexed c k →
+-- Container c` should be visible as an edge with positional label `c`.
+instance Indexed [] Int where
+ lookup' i xs
+ | i < length xs = Just (xs !! i)
+ | otherwise = Nothing
projects / classgraph.git / commitdiff