diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs index 56c1a96..cb77a4f 100644 --- a/checks/CheckFramework.hs +++ b/checks/CheckFramework.hs @@ -406,7 +406,7 @@ doTree :: ops -> -- This line applies "apply" to the first thing of the right type in -- the given AST; from there, ops recurses for itself doTree ops trans tr - = do x <- deCheckOptM (getRestartT (trans ops () (tr, routeIdentity) >> return ())) + = do x <- deCheckOptM (getRestartT (trans ops () (tr, identityRoute) >> return ())) case x of Left _ -> do -- Restart tr' <- get >>* ast diff --git a/flow/FlowGraph.hs b/flow/FlowGraph.hs index a930128..fda51b4 100644 --- a/flow/FlowGraph.hs +++ b/flow/FlowGraph.hs @@ -421,7 +421,7 @@ buildFlowGraph :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) => A.AST -> mLabel (Either String (FlowGraph' mAlter label (), [Node], [Node])) buildFlowGraph funcs s - = do res <- flip runStateT (GraphMakerState 0 0 ([],[]) [] [] []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s routeIdentity + = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s routeIdentity return $ case res of (Left err,_) -> Left err (Right _,GraphMakerState _ _ (nodes, edges) roots terminators _) @@ -432,7 +432,7 @@ buildFlowGraphP :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) => A.Structured A.Process -> mLabel (Either String (FlowGraph' mAlter label A.Process, [Node], [Node])) buildFlowGraphP funcs s - = do res <- flip runStateT (GraphMakerState 0 0 ([],[]) [] [] []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s routeIdentity + = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s routeIdentity return $ case res of (Left err,_) -> Left err (Right (root,_),GraphMakerState _ _ (nodes, edges) roots terminators _) diff --git a/polyplate/Data/Generics/Polyplate.hs b/polyplate/Data/Generics/Polyplate.hs index c4dd715..f17a912 100644 --- a/polyplate/Data/Generics/Polyplate.hs +++ b/polyplate/Data/Generics/Polyplate.hs @@ -84,14 +84,17 @@ class Monad m => PolyplateMRoute t o o' m outer where class (Monad m) => PolyplateM t o o' m where transformM :: o -> o' -> t -> m t -instance forall t ro o ro' o' m. (Monad m + +instance (Monad m , PolyplateMRoute t o o' m () , ConvertOpsToIgnoreRoute ro o , ConvertOpsToIgnoreRoute ro' o') => PolyplateM t ro ro' m where transformM o o' t = transformMRoute (convertOpsToIgnoreRoute o) (convertOpsToIgnoreRoute o') - (t, error "transformM" :: Route t ()) - + (t, fakeRoute t) + where + fakeRoute :: t -> Route t () + fakeRoute = const $ error "transformM" -- List of use cases for the Polyplate type-class, to try to decide best on its -- necessary functions: diff --git a/polyplate/Data/Generics/Polyplate/Route.hs b/polyplate/Data/Generics/Polyplate/Route.hs index fd731eb..8ffbe86 100644 --- a/polyplate/Data/Generics/Polyplate/Route.hs +++ b/polyplate/Data/Generics/Polyplate/Route.hs @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} module Data.Generics.Polyplate.Route - (routeModify, routeGet, routeSet, Route, (@->), routeIdentity, routeId, routeList, + (routeModify, routeGet, routeSet, Route, (@->), identityRoute, routeId, routeList, makeRoute, routeDataMap, routeDataSet) where @@ -55,9 +55,9 @@ import qualified Data.Set as Set -- > routeToInnerTree :: Route (BinTree Int) (BinTree (BinTree Int)) -- -- You could compose this with the earlier route: --- +-- -- > routeToInnerTree @-> myRoute :: Route Int (BinTree (BinTree Int)) --- +-- -- These routes are a little like zippers, but (in my opinion) easier to use, and -- tack on to existing code with complex data structures (without needing any code -- generation). You can either compose routes yourself (as the flow-graph building @@ -65,7 +65,7 @@ import qualified Data.Set as Set -- -- Routes support Eq, Show and Ord. All these instances represent a route as a -- list of integers: a route-map. [0,2,1] means first child (zero-based), then --- third child, then first child of the given data-type. Routes are ordered using +-- third child, then second child of the given data-type. Routes are ordered using -- the standard list ordering (lexicographic) over this representation. data Route inner outer = Route [Int] (forall m. Monad m => (inner -> m inner) -> (outer -> m outer)) @@ -91,11 +91,19 @@ routeList :: Int -> Route a [a] routeList 0 = Route [0] (\f (x:xs) -> f x >>= (\x' -> return (x': xs))) routeList n = Route [1] (\f (x:xs) -> f xs >>= (\xs' -> return (x:xs'))) @-> routeList (n-1) +-- | Constructs a Route to the key-value pair at the given index (zero-based) in +-- the ordered map. Routes involving maps are difficult because Map hides its +-- internal representation. This route secretly boxes the Map into a list of pairs +-- and back again when used. The identifiers for map entries (as used in the integer +-- list) are simply the index into the map as passed to this function. routeDataMap :: Ord k => Int -> Route (k, v) (Map.Map k v) routeDataMap n = Route [n] (\f m -> let (pre, x:post) = splitAt n (Map.toList m) in do x' <- f x return $ Map.fromList $ pre ++ (x':post)) +-- | Constructs a Route to the value at the given index (zero-based) in the ordered +-- set. See the documentation for 'routeDataMap', which is nearly identical to +-- this function. routeDataSet :: Ord k => Int -> Route k (Set.Set k) routeDataSet n = Route [n] (\f m -> let (pre, x:post) = splitAt n (Set.toList m) in do x' <- f x @@ -126,14 +134,18 @@ routeSet route x = runIdentity . routeModify route (const $ return x) -- | The identity route. This has various obvious properties: -- --- > routeGet routeIdentity == id --- > routeSet routeIdentity == const --- > routeModify routeIdentity == id --- > routeIdentity @-> route == route --- > route @-> routeIdentity == route -routeIdentity :: Route a a -routeIdentity = Route [] id +-- > routeGet identityRoute == id +-- > routeSet identityRoute == const +-- > routeModify identityRoute == id +-- > identityRoute @-> route == route +-- > route @-> identityRoute == route +identityRoute :: Route a a +identityRoute = Route [] id +-- | Given the integer list of identifiers and the modification function, forms +-- a Route. It is up to you to make sure that the integer list is valid as described +-- in the documentation of 'Route', otherwise routes constructed this way and via +-- Polyplate may exhibit strange behaviours when compared. makeRoute :: [Int] -> (forall m. Monad m => (inner -> m inner) -> (outer -> m outer)) -> Route inner outer makeRoute = Route