    -- Copyright (c) 2010-2015, David Amos. All rights reserved.

    {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances, EmptyDataDecls #-}

    -- |A module defining the category of tangles, and representations into the category of vector spaces
    -- (specifically, knot invariants).
    module Math.QuantumAlgebra.Tangle where

    import Prelude hiding ( (*>) )

    -- import qualified Data.List as L

    import Math.Algebras.VectorSpace
    import Math.Algebras.TensorProduct
    import Math.Algebras.Structures

    import Math.Algebra.Field.Base
    import Math.Algebras.LaurentPoly

    import Math.QuantumAlgebra.TensorCategory hiding (Vect)

    instance Mon [a] where
        munit :: [a]
    munit = []
        mmult :: [a] -> [a] -> [a]
    mmult = [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)

    -- type TensorAlgebra k a = Vect k [a]

    instance (Eq k, Num k, Ord a) => Algebra k [a] where
        unit :: k -> Vect k [a]
    unit 0 = Vect k [a]
    forall k b. Vect k b
    zerov -- V []
        unit x :: k
    x = [([a], k)] -> Vect k [a]
    forall k b. [(b, k)] -> Vect k b
    V [([a]
    forall m. Mon m => m
    munit,k
    x)]
        mult :: Vect k (Tensor [a] [a]) -> Vect k [a]
    mult = Vect k [a] -> Vect k [a]
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (Vect k [a] -> Vect k [a])
    -> (Vect k (Tensor [a] [a]) -> Vect k [a])
    -> Vect k (Tensor [a] [a])
    -> Vect k [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tensor [a] [a] -> [a]) -> Vect k (Tensor [a] [a]) -> Vect k [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(a :: [a]
    a,b :: [a]
    b) -> [a]
    a [a] -> [a] -> [a]
    forall m. Mon m => m -> m -> m
    `mmult` [a]
    b)

    -- Could make TensorAlgebra k a into an instance of Category, TensorCategory

    -- TANGLE CATEGORY
    -- (Unoriented)

    data Tangle

    instance MCategory Tangle where
        data Ob Tangle = OT Int deriving (Ob Tangle -> Ob Tangle -> Bool
    (Ob Tangle -> Ob Tangle -> Bool)
    -> (Ob Tangle -> Ob Tangle -> Bool) -> Eq (Ob Tangle)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Ob Tangle -> Ob Tangle -> Bool
    $c/= :: Ob Tangle -> Ob Tangle -> Bool
    == :: Ob Tangle -> Ob Tangle -> Bool
    $c== :: Ob Tangle -> Ob Tangle -> Bool
    Eq,Eq (Ob Tangle)
    Eq (Ob Tangle) =>
    (Ob Tangle -> Ob Tangle -> Ordering)
    -> (Ob Tangle -> Ob Tangle -> Bool)
    -> (Ob Tangle -> Ob Tangle -> Bool)
    -> (Ob Tangle -> Ob Tangle -> Bool)
    -> (Ob Tangle -> Ob Tangle -> Bool)
    -> (Ob Tangle -> Ob Tangle -> Ob Tangle)
    -> (Ob Tangle -> Ob Tangle -> Ob Tangle)
    -> Ord (Ob Tangle)
    Ob Tangle -> Ob Tangle -> Bool
    Ob Tangle -> Ob Tangle -> Ordering
    Ob Tangle -> Ob Tangle -> Ob Tangle
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Ob Tangle -> Ob Tangle -> Ob Tangle
    $cmin :: Ob Tangle -> Ob Tangle -> Ob Tangle
    max :: Ob Tangle -> Ob Tangle -> Ob Tangle
    $cmax :: Ob Tangle -> Ob Tangle -> Ob Tangle
    >= :: Ob Tangle -> Ob Tangle -> Bool
    $c>= :: Ob Tangle -> Ob Tangle -> Bool
    > :: Ob Tangle -> Ob Tangle -> Bool
    $c> :: Ob Tangle -> Ob Tangle -> Bool
    <= :: Ob Tangle -> Ob Tangle -> Bool
    $c<= :: Ob Tangle -> Ob Tangle -> Bool
    < :: Ob Tangle -> Ob Tangle -> Bool
    $c< :: Ob Tangle -> Ob Tangle -> Bool
    compare :: Ob Tangle -> Ob Tangle -> Ordering
    $ccompare :: Ob Tangle -> Ob Tangle -> Ordering
    $cp1Ord :: Eq (Ob Tangle)
    Ord,Int -> Ob Tangle -> ShowS
    [Ob Tangle] -> ShowS
    Ob Tangle -> String
    (Int -> Ob Tangle -> ShowS)
    -> (Ob Tangle -> String)
    -> ([Ob Tangle] -> ShowS)
    -> Show (Ob Tangle)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Ob Tangle] -> ShowS
    $cshowList :: [Ob Tangle] -> ShowS
    show :: Ob Tangle -> String
    $cshow :: Ob Tangle -> String
    showsPrec :: Int -> Ob Tangle -> ShowS
    $cshowsPrec :: Int -> Ob Tangle -> ShowS
    Show)
        data Ar Tangle = IdT Int
                       | CapT
                       | CupT
                       | OverT
                       | UnderT
    --                   | SeqT (Ar Tangle) (Ar Tangle)
                       | SeqT [Ar Tangle]
    --                   | ParT (Ar Tangle) (Ar Tangle)
                       | ParT [Ar Tangle]
                       deriving (Ar Tangle -> Ar Tangle -> Bool
    (Ar Tangle -> Ar Tangle -> Bool)
    -> (Ar Tangle -> Ar Tangle -> Bool) -> Eq (Ar Tangle)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Ar Tangle -> Ar Tangle -> Bool
    $c/= :: Ar Tangle -> Ar Tangle -> Bool
    == :: Ar Tangle -> Ar Tangle -> Bool
    $c== :: Ar Tangle -> Ar Tangle -> Bool
    Eq,Eq (Ar Tangle)
    Eq (Ar Tangle) =>
    (Ar Tangle -> Ar Tangle -> Ordering)
    -> (Ar Tangle -> Ar Tangle -> Bool)
    -> (Ar Tangle -> Ar Tangle -> Bool)
    -> (Ar Tangle -> Ar Tangle -> Bool)
    -> (Ar Tangle -> Ar Tangle -> Bool)
    -> (Ar Tangle -> Ar Tangle -> Ar Tangle)
    -> (Ar Tangle -> Ar Tangle -> Ar Tangle)
    -> Ord (Ar Tangle)
    Ar Tangle -> Ar Tangle -> Bool
    Ar Tangle -> Ar Tangle -> Ordering
    Ar Tangle -> Ar Tangle -> Ar Tangle
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Ar Tangle -> Ar Tangle -> Ar Tangle
    $cmin :: Ar Tangle -> Ar Tangle -> Ar Tangle
    max :: Ar Tangle -> Ar Tangle -> Ar Tangle
    $cmax :: Ar Tangle -> Ar Tangle -> Ar Tangle
    >= :: Ar Tangle -> Ar Tangle -> Bool
    $c>= :: Ar Tangle -> Ar Tangle -> Bool
    > :: Ar Tangle -> Ar Tangle -> Bool
    $c> :: Ar Tangle -> Ar Tangle -> Bool
    <= :: Ar Tangle -> Ar Tangle -> Bool
    $c<= :: Ar Tangle -> Ar Tangle -> Bool
    < :: Ar Tangle -> Ar Tangle -> Bool
    $c< :: Ar Tangle -> Ar Tangle -> Bool
    compare :: Ar Tangle -> Ar Tangle -> Ordering
    $ccompare :: Ar Tangle -> Ar Tangle -> Ordering
    $cp1Ord :: Eq (Ar Tangle)
    Ord,Int -> Ar Tangle -> ShowS
    [Ar Tangle] -> ShowS
    Ar Tangle -> String
    (Int -> Ar Tangle -> ShowS)
    -> (Ar Tangle -> String)
    -> ([Ar Tangle] -> ShowS)
    -> Show (Ar Tangle)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Ar Tangle] -> ShowS
    $cshowList :: [Ar Tangle] -> ShowS
    show :: Ar Tangle -> String
    $cshow :: Ar Tangle -> String
    showsPrec :: Int -> Ar Tangle -> ShowS
    $cshowsPrec :: Int -> Ar Tangle -> ShowS
    Show)
        id_ :: Ob Tangle -> Ar Tangle
    id_ (OT n) = Int -> Ar Tangle
    IdT Int
    n
        source :: Ar Tangle -> Ob Tangle
    source (IdT n) = Int -> Ob Tangle
    OT Int
    n
        source CapT = Int -> Ob Tangle
    OT 0
        source CupT = Int -> Ob Tangle
    OT 2
        source OverT = Int -> Ob Tangle
    OT 2
        source UnderT = Int -> Ob Tangle
    OT 2
    --    source (ParT a b) = OT (sa + sb) where OT sa = source a; OT sb = source b
        source (ParT as) = Int -> Ob Tangle
    OT (Int -> Ob Tangle) -> Int -> Ob Tangle
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int
    sa | Ar Tangle
    a <- [Ar Tangle]
    as, let OT sa = Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    source Ar Tangle
    a]
    --    source (SeqT a b) = source a
        source (SeqT as) = Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    source ([Ar Tangle] -> Ar Tangle
    forall a. [a] -> a
    head [Ar Tangle]
    as)
        target :: Ar Tangle -> Ob Tangle
    target (IdT n) = Int -> Ob Tangle
    OT Int
    n
        target CapT = Int -> Ob Tangle
    OT 2
        target CupT = Int -> Ob Tangle
    OT 0
        target OverT = Int -> Ob Tangle
    OT 2
        target UnderT = Int -> Ob Tangle
    OT 2
    --    target (ParT a b) = OT (ta + tb) where OT ta = target a; OT tb = target b
        target (ParT as) = Int -> Ob Tangle
    OT (Int -> Ob Tangle) -> Int -> Ob Tangle
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int
    ta | Ar Tangle
    a <- [Ar Tangle]
    as, let OT ta = Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    target Ar Tangle
    a]
    --    target (SeqT a b) = target b
        target (SeqT as) = Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    target ([Ar Tangle] -> Ar Tangle
    forall a. [a] -> a
    last [Ar Tangle]
    as)
    --    a >>> b | target a == source b = SeqT a b
        a :: Ar Tangle
    a >>> :: Ar Tangle -> Ar Tangle -> Ar Tangle
    >>> b :: Ar Tangle
    b | Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    target Ar Tangle
    a Ob Tangle -> Ob Tangle -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    source Ar Tangle
    b = [Ar Tangle] -> Ar Tangle
    SeqT [Ar Tangle
    a,Ar Tangle
    b]

    instance Monoidal Tangle where
        tunit :: Ob Tangle
    tunit = Int -> Ob Tangle
    OT 0
        tob :: Ob Tangle -> Ob Tangle -> Ob Tangle
    tob (OT a) (OT b) = Int -> Ob Tangle
    OT (Int
    aInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    b)
    --    tar a b = ParT a b
        tar :: Ar Tangle -> Ar Tangle -> Ar Tangle
    tar a :: Ar Tangle
    a b :: Ar Tangle
    b = [Ar Tangle] -> Ar Tangle
    ParT [Ar Tangle
    a,Ar Tangle
    b]

    -- KAUFFMAN BRACKET

    data Oriented = Plus | Minus deriving (Oriented -> Oriented -> Bool
    (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool) -> Eq Oriented
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Oriented -> Oriented -> Bool
    $c/= :: Oriented -> Oriented -> Bool
    == :: Oriented -> Oriented -> Bool
    $c== :: Oriented -> Oriented -> Bool
    Eq,Eq Oriented
    Eq Oriented =>
    (Oriented -> Oriented -> Ordering)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Oriented)
    -> (Oriented -> Oriented -> Oriented)
    -> Ord Oriented
    Oriented -> Oriented -> Bool
    Oriented -> Oriented -> Ordering
    Oriented -> Oriented -> Oriented
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Oriented -> Oriented -> Oriented
    $cmin :: Oriented -> Oriented -> Oriented
    max :: Oriented -> Oriented -> Oriented
    $cmax :: Oriented -> Oriented -> Oriented
    >= :: Oriented -> Oriented -> Bool
    $c>= :: Oriented -> Oriented -> Bool
    > :: Oriented -> Oriented -> Bool
    $c> :: Oriented -> Oriented -> Bool
    <= :: Oriented -> Oriented -> Bool
    $c<= :: Oriented -> Oriented -> Bool
    < :: Oriented -> Oriented -> Bool
    $c< :: Oriented -> Oriented -> Bool
    compare :: Oriented -> Oriented -> Ordering
    $ccompare :: Oriented -> Oriented -> Ordering
    $cp1Ord :: Eq Oriented
    Ord,Int -> Oriented -> ShowS
    [Oriented] -> ShowS
    Oriented -> String
    (Int -> Oriented -> ShowS)
    -> (Oriented -> String) -> ([Oriented] -> ShowS) -> Show Oriented
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Oriented] -> ShowS
    $cshowList :: [Oriented] -> ShowS
    show :: Oriented -> String
    $cshow :: Oriented -> String
    showsPrec :: Int -> Oriented -> ShowS
    $cshowsPrec :: Int -> Oriented -> ShowS
    Show)

    type TangleRep b = Vect (LaurentPoly Q) b

    -- adapted from http://blog.sigfpe.com/2008/10/untangling-with-continued-fractions.html
    cap :: [Oriented] -> TangleRep [Oriented]
    cap :: [Oriented] -> TangleRep [Oriented]
    cap [] = [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Oriented
    Plus, Oriented
    Minus] TangleRep [Oriented]
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    <+> (-LaurentPoly Q
    qLaurentPoly Q -> Integer -> LaurentPoly Q
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2) LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Oriented
    Minus, Oriented
    Plus]

    cup :: [Oriented] -> TangleRep [Oriented]
    cup :: [Oriented] -> TangleRep [Oriented]
    cup [Plus, Minus] = (-LaurentPoly Q
    q'LaurentPoly Q -> Integer -> LaurentPoly Q
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2) LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    cup [Minus, Plus] = [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    cup _ = TangleRep [Oriented]
    forall k b. Vect k b
    zerov

    -- also called xminus
    over :: [Oriented] -> TangleRep [Oriented]
    over :: [Oriented] -> TangleRep [Oriented]
    over [u :: Oriented
    u, v :: Oriented
    v] = LaurentPoly Q
    q  LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> do {[Oriented]
    _ <- [Oriented] -> TangleRep [Oriented]
    cup [Oriented
    u, Oriented
    v]; [Oriented] -> TangleRep [Oriented]
    cap []}
              TangleRep [Oriented]
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    <+> LaurentPoly Q
    q' LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Oriented
    u, Oriented
    v]

    {-
    -- if you expand "over" into terms, you find that it equals the following,
    -- which strongly resembles c' below
    over' (T i j) = case compare i j of
                    EQ -> q' *> return (T i i)                                       -- ++ -> q' ++, -- -> q' --
                    LT -> q  *> return (T j i)                                       -- +- -> q -+
                    GT -> q  *> (return (T j i) <+> (q'^2 - q^2) *> return (T i j))  -- -+ -> q +- + (q'-q^3) -+
    -}
    -- also called xplus
    under :: [Oriented] -> TangleRep [Oriented]
    under :: [Oriented] -> TangleRep [Oriented]
    under [u :: Oriented
    u, v :: Oriented
    v] = LaurentPoly Q
    q' LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> do {[Oriented]
    _ <- [Oriented] -> TangleRep [Oriented]
    cup [Oriented
    u, Oriented
    v]; [Oriented] -> TangleRep [Oriented]
    cap []}
               TangleRep [Oriented]
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    <+> LaurentPoly Q
    q  LaurentPoly Q -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> [Oriented] -> TangleRep [Oriented]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Oriented
    u, Oriented
    v]

    {-
    -- if you expand "under" into terms, you find that it equals the following,
    -- which strongly resembles c below
    under' (T i j) = case compare i j of
                     EQ -> q  *> return (T i i)                                       -- ++ -> q ++, -- -> q --
                     LT -> q' *> (return (T j i) <+> (q^2 - q'^2) *> return (T i j))  -- +- -> q' -+ + (q-q^-3) -+
                     GT -> q' *> return (T j i)                                       -- -+ -> q' +-
    -}
    loop :: TangleRep [Oriented]
    loop = TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (TangleRep [Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall a b. (a -> b) -> a -> b
    $ do {[Oriented]
    ij <- [Oriented] -> TangleRep [Oriented]
    cap []; [Oriented] -> TangleRep [Oriented]
    cup [Oriented]
    ij}

    {-
    -- The following doesn't work, because the pattern matches can fail, but Vect has no MonadFail instance.
    -- Commented out for now, pending figuring out the best fix
    trefoil = nf $ do
        [i, j] <- cap []
        [k, l] <- cap []
        [m, n] <- under [j, k]
        [p, q] <- over [i, m]
        [r, s] <- over [n, l]
        cup [p, s]
        cup [q, r]
    -}

    -- KAUFFMAN BRACKET AS A REPRESENTATION FROM TANGLE TO VECT

    -- But this isn't quite the Kauffman bracket - we still need to divide by (-q^2-q^-2)
    kauffman :: Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman :: Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman (IdT n) = TangleRep [Oriented] -> TangleRep [Oriented]
    forall a. a -> a
    id -- could be tf of n ids
    kauffman CapT = ([Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear [Oriented] -> TangleRep [Oriented]
    cap
    kauffman CupT = ([Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear [Oriented] -> TangleRep [Oriented]
    cup
    kauffman OverT = ([Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear [Oriented] -> TangleRep [Oriented]
    over
    kauffman UnderT = ([Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented] -> TangleRep [Oriented]
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear [Oriented] -> TangleRep [Oriented]
    under
    kauffman (SeqT fs) = ((TangleRep [Oriented] -> TangleRep [Oriented])
     -> (TangleRep [Oriented] -> TangleRep [Oriented])
     -> TangleRep [Oriented]
     -> TangleRep [Oriented])
    -> (TangleRep [Oriented] -> TangleRep [Oriented])
    -> [TangleRep [Oriented] -> TangleRep [Oriented]]
    -> TangleRep [Oriented]
    -> TangleRep [Oriented]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (TangleRep [Oriented] -> TangleRep [Oriented])
    -> (TangleRep [Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented]
    -> TangleRep [Oriented]
    forall a b c. (a -> b) -> (b -> c) -> a -> c
    (>>>) TangleRep [Oriented] -> TangleRep [Oriented]
    forall a. a -> a
    id ([TangleRep [Oriented] -> TangleRep [Oriented]]
     -> TangleRep [Oriented] -> TangleRep [Oriented])
    -> [TangleRep [Oriented] -> TangleRep [Oriented]]
    -> TangleRep [Oriented]
    -> TangleRep [Oriented]
    forall a b. (a -> b) -> a -> b
    $ (Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented])
    -> [Ar Tangle] -> [TangleRep [Oriented] -> TangleRep [Oriented]]
    forall a b. (a -> b) -> [a] -> [b]
    map Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman [Ar Tangle]
    fs
        where g :: a -> b
    g >>> :: (a -> b) -> (b -> c) -> a -> c
    >>> h :: b -> c
    h = b -> c
    h (b -> c) -> (a -> b) -> a -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    g
    kauffman (ParT [f]) = Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman Ar Tangle
    f
    kauffman (ParT (f:fs)) = Int
    -> (TangleRep [Oriented] -> TangleRep [Oriented])
    -> (TangleRep [Oriented] -> TangleRep [Oriented])
    -> TangleRep [Oriented]
    -> TangleRep [Oriented]
    forall k b (m :: * -> *) (m :: * -> *) a.
    (Num k, Ord b, Eq k, Show b, Algebra k b, Monad m, Monad m) =>
    Int
    -> (m [a] -> Vect k b)
    -> (m [a] -> Vect k b)
    -> Vect k [a]
    -> Vect k b
    tf Int
    m (Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman Ar Tangle
    f) (Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman ([Ar Tangle] -> Ar Tangle
    ParT [Ar Tangle]
    fs))
        where OT m = Ar Tangle -> Ob Tangle
    forall c. MCategory c => Ar c -> Ob c
    source Ar Tangle
    f
              tf :: Int
    -> (m [a] -> Vect k b)
    -> (m [a] -> Vect k b)
    -> Vect k [a]
    -> Vect k b
    tf m :: Int
    m f' :: m [a] -> Vect k b
    f' fs' :: m [a] -> Vect k b
    fs' = ([a] -> Vect k b) -> Vect k [a] -> Vect k b
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear (\xs :: [a]
    xs -> let (ls :: [a]
    ls,rs :: [a]
    rs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    m [a]
    xs in m [a] -> Vect k b
    f' ([a] -> m [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    ls) Vect k b -> Vect k b -> Vect k b
    forall a. Num a => a -> a -> a
    * m [a] -> Vect k b
    fs' ([a] -> m [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    rs) )
    {-
    kauffman (ParT f g) = tf m n (kauffman f) (kauffman g)
        where OT m = source f
              OT n = source g
              tf m n f' g' = linear (\xs -> let (ls,rs) = splitAt m xs in f' (return ls) * g' (return rs) )
    -}

    -- loopT = SeqT CapT CupT
    loopT :: Ar Tangle
    loopT = [Ar Tangle] -> Ar Tangle
    SeqT [Ar Tangle
    CapT, Ar Tangle
    CupT]

    {-
    trefoilT = (ParT CapT CapT) `SeqT` (ParT (IdT 1) (ParT UnderT (IdT 1)))
        `SeqT` (ParT OverT OverT) `SeqT` (ParT (IdT 1) (ParT CupT (IdT 1))) `SeqT` CupT

    trefoilT = ParT [CapT, CapT]
        `SeqT` ParT [IdT 1, UnderT, IdT 1]
        `SeqT` ParT [OverT, OverT]
        `SeqT` ParT [IdT 1, CupT, IdT 1]
        `SeqT` CupT
    -}
    trefoilT :: Ar Tangle
    trefoilT = [Ar Tangle] -> Ar Tangle
    SeqT [
        [Ar Tangle] -> Ar Tangle
    ParT [Ar Tangle
    CapT, Ar Tangle
    CapT],
        [Ar Tangle] -> Ar Tangle
    ParT [Int -> Ar Tangle
    IdT 1, Ar Tangle
    UnderT, Int -> Ar Tangle
    IdT 1],
        [Ar Tangle] -> Ar Tangle
    ParT [Ar Tangle
    OverT, Ar Tangle
    OverT],
        [Ar Tangle] -> Ar Tangle
    ParT [Int -> Ar Tangle
    IdT 1, Ar Tangle
    CupT, Int -> Ar Tangle
    IdT 1],
        Ar Tangle
    CupT]
    -- eg kauffman (trefoilT) (return [])