{- This file is part of tie-knot. tie-knot is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. tie-knot is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with tie-knot. If not, see . -} {-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-} -- | Module for tying the knot on data structures that reference each other by -- some kind of keys. The 'tie' function replaces all such references with the actual -- value, creating possibly recursive or cyclic data structures. -- -- The module re-exports a part of the recursion-schemes package. -- -- An example how to construct a structure with circular dependencies: -- -- > data Person = Person { name :: String, loves :: [Person] } -- > -- Define a variant of Person where the recursive type -- > -- is given as a parameter and the embedding function. -- > data Loves t = Loves { _name :: String, _loves :: [t] } -- > type instance Base Person = Loves -- > instance Unfoldable Person where -- > embed ~(Loves n ps) = Person n ps -- > -- > -- The easisest way to get 'Foldable' + 'Functor' is to implement -- > -- 'Traversable' and then just use the default implementations. -- > instance T.Traversable Loves where -- > traverse f (Loves n ns) = Loves n <$> T.traverse f ns -- > -- > instance Functor Loves where -- > fmap = T.fmapDefault -- > instance F.Foldable Loves where -- > foldMap = T.foldMapDefault -- > -- > -- Let's create a person with cicrular dependencies: -- > alice :: Person -- > alice = fromJust . Map.lookup "Alice" . -- > tie' . Map.fromList . map (\l -> (_name l, l)) $ lst -- > where -- > lst = [ Loves "Alice" ["Bob", "cat"] -- > , Loves "Bob" ["Alice"] -- > -- you may disagree, but the cat thinks of itself as Person -- > , Loves "cat" ["cat"] -- > ] module Data.Knot (tie, tie', isConsistent, RefMap, TieError(..), Base, Unfoldable, embed) where import Control.Monad import Control.Monad.Error import qualified Data.Foldable as F import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid import Data.Maybe import Data.Functor.Foldable -- | Represents a set of data 'v' that reference each other -- using keys of type 'k'. type RefMap k v = Map k (v k) -- | Possible errors when tying the knot. data TieError k = MissingKey k k -- ^ A value with key k1 referenced non-existent key k2. deriving (Show, Eq, Ord) -- | Check the loader for consistency, i.e. if all referenced keys -- have a corresponding value. Values need to implement 'Foldable' -- that traverses over all referenced keys. isConsistent :: (Ord k, F.Foldable v, Functor v) => RefMap k v -- ^ The loader to check. -> Either (TieError k) (RefMap k v) -- ^ The loader argument or an error. isConsistent l = maybe (Right l) Left . getFirst $ Map.foldrWithKey (\k -> mappend . keysOk k) mempty l where keysOk k = F.foldMap (\r -> First $ if (Map.member r l) then Nothing else (Just (MissingKey k r)) ) -- | Helper function for anamorphisms. ana' :: Unfoldable t => (s -> Base t s) -> Base t s -> t ana' f = embed . fmap (ana f) -- | Ties the knot without checking consistency. -- If the references are inconsistent, an exception is raised. tie' :: (Ord k, Unfoldable v) => RefMap k (Base v) -> Map k v tie' m = Map.map f m where -- (k -> v k) -> v k -> Fix v f = ana' $ \k -> fromJust (Map.lookup k m) -- | Checks consistency by calling 'isConsistent' and then and ties the knot using 'tie''. tie :: (Ord k, F.Foldable (Base v), Unfoldable v) => RefMap k (Base v) -> Either (TieError k) (Map k v) tie = liftM tie' . isConsistent