DualKnot.hs

{-# LANGUAGE TypeFamilies #-}
import Data.Functor
import Data.Functor.Compose
import qualified Data.Foldable as F
import Data.Knot
import qualified Data.Map as M
import qualified Data.Traversable as T

-- * Functor data types
-- ** Person'

{-
instance Unfoldable Person where
  embed ~(Person' n ps) = Person n ps
-}

data Person' t = Person' { _name :: String, _publications :: [t] }

instance T.Traversable Person' where
  traverse f (Person' n p) = Person' n <$> T.traverse f p

instance Functor Person' where
  fmap = T.fmapDefault

instance F.Foldable Person' where
  foldMap = T.foldMapDefault

-- ** Publication'

data Publication' t = Publication' { _title :: String, _authors :: [t] }

instance T.Traversable Publication' where
  traverse f (Publication' n p) = Publication' n <$> T.traverse f p

instance Functor Publication' where
  fmap = T.fmapDefault

instance F.Foldable Publication' where
  foldMap = T.foldMapDefault

-- * Combination

data Person = Person { name :: String, publications :: [Publication] }

data Publication = Publication { title :: String, authors :: [Person]}

type instance Base Person = Compose Person' Publication'

instance Unfoldable Person where
  embed ~(Compose (Person' n ps)) = Person n (map embedPub ps)
    where
      embedPub ~(Publication' t as) = Publication t as