```module Data.Logical.Knot
( Knot
, KnotT
, MonadKnot
, askKnot
, askKnotDef
, (*=)
, accKnot
, tieKnot
, accKnotT
, tieKnotT
) where

import Data.Map (Map,fromList,fromListWith,(!),findWithDefault)
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Writer

type Constraint i x = (i,x)
type Solution   i x = Map i x

newtype Knot i x a =
Knot (ReaderT (Solution i x) (Writer [Constraint i x]) a)
deriving (Functor, Applicative, Monad, MonadFix)

newtype KnotT i x m a =
KnotT (ReaderT (Solution i x) (WriterT [Constraint i x] m) a)
deriving (Functor, Applicative, Monad, MonadFix)

instance MonadTrans (KnotT i x)
where
lift = KnotT . lift . lift
-- Couldn't be derived for some reason

class (Monad m, Ord i) => MonadKnot i x m | m -> i x
where
askKnot    ::      i -> m x
askKnotDef :: x -> i -> m x

(*=) :: i -> x -> m ()

instance Ord i => MonadKnot i x (Knot i x)
where
askKnot i        = Knot \$ asks (! i)
askKnotDef def i = Knot \$ asks \$ findWithDefault def i

i *= x = Knot \$ tell [(i,x)]

instance (Monad m, Ord i) => MonadKnot i x (KnotT i x m)
where
askKnot i        = KnotT \$ asks (! i)
askKnotDef def i = KnotT \$ asks \$ findWithDefault def i

i *= x = KnotT \$ tell [(i,x)]

accKnot :: Ord i => (x -> x -> x) -> Knot i x a -> (a, Map i x)
accKnot acc (Knot knot) = (a,solution)
where
(a,ass)  = runWriter \$ runReaderT knot solution
solution = fromListWith acc ass
-- acc should be commutative and associative.

tieKnot :: Ord i => Knot i x a -> (a, Map i x)
tieKnot = accKnot (error "tieKnot: Over-constrained")

accKnotT
:: (Ord i, MonadFix m)
=> (x -> x -> x) -> KnotT i x m a -> m (a, Map i x)
accKnotT acc (KnotT knot) = mdo
(a,ass) <- runWriterT \$ runReaderT knot solution
let solution = fromListWith acc ass
return (a,solution)
-- acc should be commutative and associative.

tieKnotT :: (Ord i, MonadFix m) => KnotT i x m a -> m (a, Map i x)
tieKnotT = accKnotT (error "tieKnot: Over-constrained")

```