{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Test.Labelled.Graph
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- Testsuite for "Algebra.Graph.Labelled.Graph".
-----------------------------------------------------------------------------
module Algebra.Graph.Test.Labelled.Graph (
    -- * Testsuite
    testLabelledGraph
    ) where

import Data.Monoid (Any, Sum (..))

import Algebra.Graph.Label
import Algebra.Graph.Labelled
import Algebra.Graph.Test
import Algebra.Graph.Test.API (toIntAPI, labelledGraphAPI)
import Algebra.Graph.Test.Generic

import qualified Algebra.Graph.ToGraph as T
import qualified Data.Set              as Set

tPoly :: Testsuite (Graph Any) Ord
tPoly = ("Labelled.Graph.", labelledGraphAPI)

t :: TestsuiteInt (Graph Any)
t = fmap toIntAPI tPoly

type S = Sum Int
type D = Distance Int

type LAI = Graph Any Int
type LAS = Graph S   Int
type LAD = Graph D   Int

testLabelledGraph :: IO ()
testLabelledGraph = do
    testEmpty  t
    testVertex t

    putStrLn "\n============ Labelled.Graph.edge ============"
    test "edge e    x y              == connect e (vertex x) (vertex y)" $ \(e :: S) (x :: Int) y ->
          edge e    x y              == connect e (vertex x) (vertex y)

    test "edge zero x y              == vertices [x,y]" $ \(x :: Int) y ->
          edge (zero :: S) x y       == vertices [x,y]

    test "hasEdge   x y (edge e x y) == (e /= mempty)" $ \(e :: S) (x :: Int) y ->
          hasEdge   x y (edge e x y) == (e /= mempty)

    test "edgeLabel x y (edge e x y) == e" $ \(e :: S) (x :: Int) y ->
          edgeLabel x y (edge e x y) == e

    test "edgeCount     (edge e x y) == if e == mempty then 0 else 1" $ \(e :: S) (x :: Int) y ->
          T.edgeCount     (edge e x y) == if e == mempty then 0 else 1

    test "vertexCount   (edge e 1 1) == 1" $ \(e :: S) ->
          T.vertexCount   (edge e 1 (1 :: Int)) == 1

    test "vertexCount   (edge e 1 2) == 2" $ \(e :: S) ->
          T.vertexCount   (edge e 1 (2 :: Int)) == 2

    test "x -<e>- y                  == edge e x y" $ \(e :: S) (x :: Int) y ->
          x -<e>- y                  == edge e x y

    testOverlay t

    putStrLn ""
    test "edgeLabel x y $ overlay (edge e x y) (edge zero x y) == e" $ \(e :: S) (x :: Int) y ->
          edgeLabel x y (overlay (edge e x y) (edge zero x y)) == e

    test "edgeLabel x y $ overlay (edge e x y) (edge f    x y) == e <+> f" $ \(e :: S) f (x :: Int) y ->
          edgeLabel x y (overlay (edge e x y) (edge f    x y)) == e <+> f

    putStrLn ""
    test "edgeLabel 1 3 $ transitiveClosure (overlay (edge e 1 2) (edge one 2 3)) == e" $ \(e :: D) ->
          edgeLabel 1 3 (transitiveClosure (overlay (edge e 1 2) (edge one 2 (3 :: Int)))) == e

    test "edgeLabel 1 3 $ transitiveClosure (overlay (edge e 1 2) (edge f   2 3)) == e <.> f" $ \(e :: D) f ->
          edgeLabel 1 3 (transitiveClosure (overlay (edge e 1 2) (edge f   2 (3 :: Int))))== e <.> f

    putStrLn "\n============ Labelled.Graph.connect ============"
    test "isEmpty     (connect e x y) == isEmpty   x   && isEmpty   y" $ size10 $ \(e :: S) (x :: LAS) y ->
          isEmpty     (connect e x y) ==(isEmpty   x   && isEmpty   y)

    test "hasVertex z (connect e x y) == hasVertex z x || hasVertex z y" $ size10 $ \(e :: S) (x :: LAS) y z ->
          hasVertex z (connect e x y) ==(hasVertex z x || hasVertex z y)

    test "vertexCount (connect e x y) >= vertexCount x" $ size10 $ \(e :: S) (x :: LAS) y ->
          T.vertexCount (connect e x y) >= T.vertexCount x

    test "vertexCount (connect e x y) <= vertexCount x + vertexCount y" $ size10 $ \(e :: S) (x :: LAS) y ->
          T.vertexCount (connect e x y) <= T.vertexCount x + T.vertexCount y

    test "edgeCount   (connect e x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ size10 $ \(e :: S) (x :: LAS) y ->
          T.edgeCount   (connect e x y) <= T.vertexCount x * T.vertexCount y + T.edgeCount x + T.edgeCount y

    test "vertexCount (connect e 1 2) == 2" $ \(e :: Any) ->
          T.vertexCount (connect e 1 (2 :: LAI)) == 2

    test "edgeCount   (connect e 1 2) == if e == zero then 0 else 1" $ \(e :: Any) ->
          T.edgeCount   (connect e 1 (2 :: LAI)) == if e == zero then 0 else 1

    testVertices t

    putStrLn "\n============ Labelled.Graph.edges ============"
    test "edges []        == empty" $
          edges []        == (empty :: LAS)

    test "edges [(e,x,y)] == edge e x y" $ \(e :: S) (x :: Int) y ->
          edges [(e,x,y)] == edge e x y

    test "edges           == overlays . map (\\(e, x, y) -> edge e x y)" $ \(es :: [(S, Int, Int)]) ->
          edges es        ==(overlays . map (\(e, x, y) -> edge e x y)) es

    testOverlays t

    putStrLn "\n============ Labelled.Graph.foldg ============"
    test "foldg empty     vertex        connect             == id" $ \(x :: LAS) ->
          foldg empty     vertex        connect x           == id x

    test "foldg empty     vertex        (fmap flip connect) == transpose" $ \(x :: LAS) ->
          foldg empty     vertex        (fmap flip connect) x == transpose x

    test "foldg 1         (const 1)     (const (+))         == size" $ \(x :: LAS) ->
          foldg 1         (const 1)     (const (+)) x       == size x

    test "foldg True      (const False) (const (&&))        == isEmpty" $ \(x :: LAS) ->
          foldg True      (const False) (const (&&)) x      == isEmpty x

    test "foldg False     (== x)        (const (||))        == hasVertex x" $ \x (y :: LAS) ->
          foldg False     (== x)        (const (||)) y      == hasVertex x y

    test "foldg Set.empty Set.singleton (const Set.union)   == vertexSet" $ \(x :: LAS) ->
          foldg Set.empty Set.singleton (const Set.union) x == vertexSet x

    putStrLn "\n============ Labelled.Graph.buildg ============"
    test "buildg (\\e _ _ -> e)                                   == empty" $
          buildg ( \e _ _ -> e)                                   == (empty :: LAS)

    test "buildg (\\_ v _ -> v x)                                 == vertex x" $ \x ->
          buildg ( \_ v _ -> v x)                                 == (vertex x :: LAS)

    test "buildg (\\e v c -> c l (foldg e v c x) (foldg e v c y)) == connect l x y" $ \l (x :: LAS) y ->
          buildg ( \e v c -> c l (foldg e v c x) (foldg e v c y)) == connect l x y

    test "buildg (\\e v c -> foldr (c zero) e (map v xs))         == vertices xs" $ \xs ->
          buildg ( \e v c -> foldr (c zero) e (map v xs))         == (vertices xs :: LAS)

    test "buildg (\\e v c -> foldg e v (flip c) g)                == transpose g" $ \(g :: LAS) ->
          buildg ( \e v c -> foldg e v (flip . c) g)              == transpose g

    putStrLn "\n============ Labelled.Graph.isSubgraphOf ============"
    test "isSubgraphOf empty      x     ==  True" $ \(x :: LAS) ->
          isSubgraphOf empty      x     ==  True

    test "isSubgraphOf (vertex x) empty ==  False" $ \(x :: Int) ->
          isSubgraphOf (vertex x)(empty :: LAS)==  False

    test "isSubgraphOf x y              ==> x <= y" $ \(x :: LAD) z ->
        let y = x + z -- Make sure we hit the precondition
        in isSubgraphOf x y             ==> x <= y

    putStrLn "\n============ Labelled.Graph.isEmpty ============"
    test "isEmpty empty                         == True" $
          isEmpty empty                         == True

    test "isEmpty (overlay empty empty)         == True" $
          isEmpty (overlay empty empty :: LAS)  == True

    test "isEmpty (vertex x)                    == False" $ \(x :: Int) ->
          isEmpty (vertex x)                    == False

    test "isEmpty (removeVertex x $ vertex x)   == True" $ \(x :: Int) ->
          isEmpty (removeVertex x $ vertex x)   == True

    test "isEmpty (removeEdge x y $ edge e x y) == False" $ \(e :: S) (x :: Int) y ->
          isEmpty (removeEdge x y $ edge e x y) == False

    testSize t
    testHasVertex t

    putStrLn "\n============ Labelled.Graph.hasEdge ============"
    test "hasEdge x y empty            == False" $ \(x :: Int) y ->
          hasEdge x y (empty :: LAS)   == False

    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->
          hasEdge x y (vertex z :: LAS) == False

    test "hasEdge x y (edge e x y)     == (e /= zero)" $ \(e :: S) (x :: Int) y ->
          hasEdge x y (edge e x y)     == (e /= zero)

    test "hasEdge x y . removeEdge x y == const False" $ \x y (z :: LAS) ->
         (hasEdge x y . removeEdge x y) z == const False z

    test "hasEdge x y                  == not . null . filter (\\(_,ex,ey) -> ex == x && ey == y) . edgeList" $ \x y (z :: LAS) -> do
        (_, u, v) <- elements ((zero, x, y) : edgeList z)
        return $ hasEdge u v z         == (not . null . filter (\(_,ex,ey) -> ex == u && ey == v) . edgeList) z

    putStrLn "\n============ Labelled.Graph.edgeLabel ============"
    test "edgeLabel x y empty         == zero" $ \(x :: Int) y ->
          edgeLabel x y empty         == (zero :: S)

    test "edgeLabel x y (vertex z)    == zero" $ \(x :: Int) y z ->
          edgeLabel x y (vertex z)    == (zero :: S)

    test "edgeLabel x y (edge e x y)  == e" $ \(e :: S) (x :: Int) y ->
          edgeLabel x y (edge e x y)  == e

    test "edgeLabel s t (overlay x y) == edgeLabel s t x + edgeLabel s t y" $ \(x :: LAS) y -> do
        z <- arbitrary
        s <- elements ([z] ++ T.vertexList x ++ T.vertexList y)
        t <- elements ([z] ++ T.vertexList x ++ T.vertexList y)
        return $ edgeLabel s t (overlay x y) == edgeLabel s t x + edgeLabel s t y

    testVertexCount t

    putStrLn "\n============ Labelled.Graph.edgeCount ============"
    test "edgeCount empty        == 0" $
          T.edgeCount (empty :: LAS) == 0

    test "edgeCount (vertex x)   == 0" $ \(x :: Int) ->
          T.edgeCount (vertex x :: LAS) == 0

    test "edgeCount (edge e x y) == if e == zero then 0 else 1" $ \(e :: S) (x :: Int) y ->
          T.edgeCount (edge e x y) == if e == zero then 0 else 1

    test "edgeCount              == length . edgeList" $ \(x :: LAS) ->
          T.edgeCount x            == (length . edgeList) x

    testVertexList t

    putStrLn "\n============ Labelled.Graph.edgeList ============"
    test "edgeList empty        == []" $
          edgeList (empty :: LAS) == []

    test "edgeList (vertex x)   == []" $ \(x :: Int) ->
          edgeList (vertex x :: LAS) == []

    test "edgeList (edge e x y) == if e == zero then [] else [(e,x,y)]" $ \(e :: S) (x :: Int) y ->
          edgeList (edge e x y) == if e == zero then [] else [(e,x,y)]

    testVertexSet t

    putStrLn "\n============ Labelled.Graph.edgeSet ============"
    test "edgeSet empty        == Set.empty" $
          edgeSet (empty :: LAS) == Set.empty

    test "edgeSet (vertex x)   == Set.empty" $ \(x :: Int) ->
          edgeSet (vertex x :: LAS) == Set.empty

    test "edgeSet (edge e x y) == if e == zero then Set.empty else Set.singleton (e,x,y)" $ \(e :: S) (x :: Int) y ->
          edgeSet (edge e x y) == if e == zero then Set.empty else Set.singleton (e,x,y)

    putStrLn "\n============ Labelled.Graph.preSet ============"
    test "preSet x empty        == Set.empty" $ \x ->
          T.preSet x (empty :: LAS) == Set.empty

    test "preSet x (vertex x)   == Set.empty" $ \x ->
          T.preSet x (vertex x :: LAS) == Set.empty

    test "preSet 1 (edge e 1 2) == Set.empty" $ \e ->
          T.preSet 1 (edge e 1 2 :: LAS) == Set.empty

    test "preSet y (edge e x y) == if e == zero then Set.empty else Set.fromList [x]" $ \(e :: S) (x :: Int) y ->
          T.preSet y (edge e x y) == if e == zero then Set.empty else Set.fromList [x]

    putStrLn "\n============ Labelled.Graph.postSet ============"
    test "postSet x empty        == Set.empty" $ \x ->
          T.postSet x (empty :: LAS) == Set.empty

    test "postSet x (vertex x)   == Set.empty" $ \x ->
          T.postSet x (vertex x :: LAS) == Set.empty

    test "postSet x (edge e x y) == if e == zero then Set.empty else Set.fromList [y]" $ \(e :: S) (x :: Int) y ->
          T.postSet x (edge e x y) == if e == zero then Set.empty else Set.fromList [y]

    test "postSet 2 (edge e 1 2) == Set.empty" $ \e ->
          T.postSet 2 (edge e 1 2 :: LAS) == Set.empty

    putStrLn "\n============ Labelled.Graph.removeVertex ============"
    test "removeVertex x (vertex x)       == empty" $ \x ->
          removeVertex x (vertex x)       == (empty :: LAS)

    test "removeVertex 1 (vertex 2)       == vertex 2" $
          removeVertex 1 (vertex 2)       == (vertex 2 :: LAS)

    test "removeVertex x (edge e x x)     == empty" $ \(e :: S) (x :: Int) ->
          removeVertex x (edge e x x)     == empty

    test "removeVertex 1 (edge e 1 2)     == vertex 2" $ \(e :: S) ->
          removeVertex 1 (edge e 1 2)     == vertex (2 :: Int)

    test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: LAS) ->
         (removeVertex x . removeVertex x) y == removeVertex x y

    putStrLn "\n============ Labelled.Graph.removeEdge ============"
    test "removeEdge x y (edge e x y)     == vertices [x,y]" $ \(e :: S) (x :: Int) y ->
          removeEdge x y (edge e x y)     == vertices [x,y]

    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \x y (z :: LAS) ->
         (removeEdge x y . removeEdge x y) z == removeEdge x y z

    test "removeEdge x y . removeVertex x == removeVertex x" $ \x y (z :: LAS) ->
         (removeEdge x y . removeVertex x) z == removeVertex x z

    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $
          removeEdge 1 1 (1 * 1 * 2 * 2)  == (1 * 2 * 2 :: LAD)

    test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $
          removeEdge 1 2 (1 * 1 * 2 * 2)  == (1 * 1 + 2 * 2 :: LAD)

    putStrLn "\n============ Labelled.Graph.replaceVertex ============"
    test "replaceVertex x x            == id" $ \x y ->
          replaceVertex x x y          == (y :: LAS)

    test "replaceVertex x y (vertex x) == vertex y" $ \x y ->
          replaceVertex x y (vertex x) == (vertex y :: LAS)

    test "replaceVertex x y            == fmap (\\v -> if v == x then y else v)" $ \x y (z :: LAS) ->
          replaceVertex x y z          == fmap (\v -> if v == x then y else v) z

    putStrLn "\n============ Labelled.Graph.replaceEdge ============"
    test "replaceEdge e x y z                 == overlay (removeEdge x y z) (edge e x y)" $ \(e :: S) (x :: Int) y z ->
          replaceEdge e x y z                 == overlay (removeEdge x y z) (edge e x y)

    test "replaceEdge e x y (edge f x y)      == edge e x y" $ \(e :: S) f (x :: Int) y ->
          replaceEdge e x y (edge f x y)      == edge e x y

    test "edgeLabel x y (replaceEdge e x y z) == e" $ \(e :: S) (x :: Int) y z ->
          edgeLabel x y (replaceEdge e x y z) == e

    putStrLn "\n============ Labelled.Graph.transpose ============"
    test "transpose empty        == empty" $
          transpose empty        == (empty :: LAS)

    test "transpose (vertex x)   == vertex x" $ \x ->
          transpose (vertex x)   == (vertex x :: LAS)

    test "transpose (edge e x y) == edge e y x" $ \e x y ->
          transpose (edge e x y) == (edge e y x :: LAS)

    test "transpose . transpose == id" $ size10 $ \x ->
         (transpose . transpose) x == (x :: LAS)

    putStrLn "\n============ Labelled.Graph.fmap ============"
    test "fmap f empty        == empty" $ \(apply -> f) ->
          fmap f (empty :: LAS) == (empty :: LAS)

    test "fmap f (vertex x)   == vertex (f x)" $ \(apply -> f) x ->
          fmap f (vertex x :: LAS) == (vertex (f x) :: LAS)

    test "fmap f (edge e x y) == edge e (f x) (f y)" $ \(apply -> f) e x y ->
          fmap f (edge e x y :: LAS) == (edge e (f x) (f y) :: LAS)

    test "fmap id             == id" $ \x ->
          fmap id x           == (x :: LAS)

    test "fmap f . fmap g     == fmap (f . g)" $ \(apply -> f) (apply -> g) x ->
         ((fmap f :: LAS -> LAS) . fmap g) (x :: LAS)  == fmap (f . g) x

    -- TODO: We only test homomorphisms @h@ on @Sum Int@, which all happen to be
    -- just linear transformations: @h = (k*)@ for some @k :: Int@. These tests
    -- are therefore rather weak and do not cover the ruch space of possible
    -- monoid homomorphisms. How can we improve this?
    putStrLn "\n============ Labelled.Graph.emap ============"
    test "emap h empty           == empty" $ \(k :: S) ->
        let h = (k*)
        in emap h empty          == (empty :: LAS)

    test "emap h (vertex x)      == vertex x" $ \(k :: S) x ->
        let h = (k*)
        in emap h (vertex x)     == (vertex x :: LAS)

    test "emap h (edge e x y)    == edge (h e) x y" $ \(k :: S) e x y ->
        let h = (k*)
        in emap h (edge e x y)   == (edge (h e) x y :: LAS)

    test "emap h (overlay x y)   == overlay (emap h x) (emap h y)" $ \(k :: S) x y ->
        let h = (k*)
        in emap h (overlay x y)  == (overlay (emap h x) (emap h y) :: LAS)

    test "emap h (connect e x y) == connect (h e) (emap h x) (emap h y)" $ \(k :: S) (e :: S) x y ->
        let h = (k*)
        in emap h (connect e x y) == (connect (h e) (emap h x) (emap h y) :: LAS)

    test "emap id                == id" $ \x ->
          emap id x              == (id x :: LAS)

    test "emap g . emap h        == emap (g . h)" $ \(k :: S) (l :: S) x ->
        let h = (k*)
            g = (l*)
        in (emap g . emap h) x   == (emap (g . h) x :: LAS)

    testInduce     t
    testInduceJust tPoly

    putStrLn "\n============ Labelled.Graph.closure ============"
    test "closure empty         == empty" $
          closure empty         == (empty :: LAD)

    test "closure (vertex x)    == edge one x x" $ \x ->
          closure (vertex x)    == (edge one x x :: LAD)

    test "closure (edge e x x)  == edge one x x" $ \e x ->
          closure (edge e x x)  == (edge one x x :: LAD)

    test "closure (edge e x y)  == edges [(one,x,x), (e,x,y), (one,y,y)]" $ \e x y ->
          closure (edge e x y)  == (edges [(one,x,x), (e,x,y), (one,y,y)] :: LAD)

    test "closure               == reflexiveClosure . transitiveClosure" $ size10 $ \x ->
          closure (x :: LAD)    == (reflexiveClosure . transitiveClosure) x

    test "closure               == transitiveClosure . reflexiveClosure" $ size10 $ \x ->
          closure (x :: LAD)    == (transitiveClosure . reflexiveClosure) x

    test "closure . closure     == closure" $ size10 $ \x ->
         (closure . closure) x  == closure (x :: LAD)

    test "postSet x (closure y) == Set.fromList (reachable y x)" $ size10 $ \(x :: Int) (y :: LAD) ->
          T.postSet x (closure y) == Set.fromList (T.reachable y x)

    putStrLn "\n============ Labelled.Graph.reflexiveClosure ============"
    test "reflexiveClosure empty              == empty" $
          reflexiveClosure empty              == (empty :: LAD)

    test "reflexiveClosure (vertex x)         == edge one x x" $ \x ->
          reflexiveClosure (vertex x)         == (edge one x x :: LAD)

    test "reflexiveClosure (edge e x x)       == edge one x x" $ \e x ->
          reflexiveClosure (edge e x x)       == (edge one x x :: LAD)

    test "reflexiveClosure (edge e x y)       == edges [(one,x,x), (e,x,y), (one,y,y)]" $ \e x y ->
          reflexiveClosure (edge e x y)       == (edges [(one,x,x), (e,x,y), (one,y,y)] :: LAD)

    test "reflexiveClosure . reflexiveClosure == reflexiveClosure" $ size10 $ \x ->
         (reflexiveClosure . reflexiveClosure) x == reflexiveClosure (x :: LAD)

    putStrLn "\n============ Labelled.Graph.symmetricClosure ============"
    test "symmetricClosure empty              == empty" $
          symmetricClosure empty              == (empty :: LAD)

    test "symmetricClosure (vertex x)         == vertex x" $ \x ->
          symmetricClosure (vertex x)         == (vertex x :: LAD)

    test "symmetricClosure (edge e x y)       == edges [(e,x,y), (e,y,x)]" $ \e x y ->
          symmetricClosure (edge e x y)       == (edges [(e,x,y), (e,y,x)] :: LAD)

    test "symmetricClosure x                  == overlay x (transpose x)" $ \x ->
          symmetricClosure x                  == (overlay x (transpose x) :: LAD)

    test "symmetricClosure . symmetricClosure == symmetricClosure" $ size10 $ \x ->
         (symmetricClosure . symmetricClosure) x == symmetricClosure (x :: LAD)

    putStrLn "\n============ Labelled.Graph.transitiveClosure ============"
    test "transitiveClosure empty               == empty" $
          transitiveClosure empty               == (empty :: LAD)

    test "transitiveClosure (vertex x)          == vertex x" $ \x ->
          transitiveClosure (vertex x)          == (vertex x :: LAD)

    test "transitiveClosure (edge e x y)        == edge e x y" $ \e x y ->
          transitiveClosure (edge e x y)        == (edge e x y :: LAD)

    test "transitiveClosure . transitiveClosure == transitiveClosure" $ size10 $ \x ->
         (transitiveClosure . transitiveClosure) x == transitiveClosure (x :: LAD)

    putStrLn "\n============ Labelled.Graph.context ============"
    test "context (const False) x                   == Nothing" $ \x ->
          context (const False) (x :: LAS)          == Nothing

    test "context (== 1)        (edge e 1 2)        == if e == zero then Just (Context [] []) else Just (Context []      [(e,2)])" $ \e ->
          context (== 1)        (edge e 1 2 :: LAS) == if e == zero then Just (Context [] []) else Just (Context []      [(e,2)])

    test "context (== 2)        (edge e 1 2)        == if e == zero then Just (Context [] []) else Just (Context [(e,1)] []     )" $ \e ->
          context (== 2)        (edge e 1 2 :: LAS) == if e == zero then Just (Context [] []) else Just (Context [(e,1)] []     )

    test "context (const True ) (edge e 1 2)        == if e == zero then Just (Context [] []) else Just (Context [(e,1)] [(e,2)])" $ \e ->
          context (const True ) (edge e 1 2 :: LAS) == if e == zero then Just (Context [] []) else Just (Context [(e,1)] [(e,2)])

    test "context (== 4)        (3 * 1 * 4 * 1 * 5) == Just (Context [(one,3), (one,1)] [(one,1), (one,5)])" $
          context (== 4)        (3 * 1 * 4 * 1 * 5 :: LAD) == Just (Context [(one,3), (one,1)] [(one,1), (one,5)])