alloy 1.0.0 → 1.1.0

raw patch · 6 files changed

+56/−29 lines, 6 filesdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Generics/Alloy.hs +1/−1
• Data/Generics/Alloy/Effect.hs +1/−1
• Data/Generics/Alloy/GenInstances.hs +47/−18
• Data/Generics/Alloy/Route.hs +1/−1
• alloy.cabal +5/−7
• tutorial/CompanyDatatypes.lhs +1/−1

@@ -36,6 +36,7 @@ -- (<http://twistedsquare.com/Alloy-Tutorial.pdf>) provides examples of each -- of these.  The tutorial also explains how to use the "Data.Generics.Alloy.GenInstances" -- module to generate the instances that Alloy needs for your data.+ module Data.Generics.Alloy (   module Data.Generics.Alloy.Pure,   module Data.Generics.Alloy.Effect,@@ -47,5 +48,4 @@ import Data.Generics.Alloy.Effect import Data.Generics.Alloy.Route import Data.Generics.Alloy.Schemes- 

@@ -87,7 +87,7 @@ -- in this module.  Whereas there is, for example, both 'makeRecurseA' and 'makeRecurseM', -- there is only one terminator for the opsets, 'BaseOpA', which should be used -- regardless of whether you use 'makeRecurseA' or 'makeRecurseM'.-data BaseOpA m = BaseOpA+data BaseOpA (m :: * -> *) = BaseOpA  -- | The function to give you an item of type 'BaseOpA'. baseOpA :: BaseOpA m

@@ -1,5 +1,5 @@ -- Alloy.--- Copyright (c) 2008-2009, University of Kent.+-- Copyright (c) 2008-2009, 2012 University of Kent. -- All rights reserved. --  -- Redistribution and use in source and binary forms, with or without@@ -75,7 +75,12 @@ import Data.Ord import Data.Set (Set) import qualified Data.Set as Set+import qualified Data.Typeable as Ty +#if __GLASGOW_HASKELL__ < 702+type TypeRepKey = Int+#endif+ -- | The option controlling whether the generated instances can be overlapped. --  If you choose 'GenWithOverlapped' many less instances (around half, in our --  experience) will be generated, but you must enable the@@ -199,7 +204,7 @@        -- in a Map.        findTypesIn (const Nothing) (k, v) -- This does types in k and v, and their pairing        tk <- liftIO $ typeKey m-       modify (Map.insert tk (show $ typeOf m,+       modify (Map.insert tk (toQualName m,          Detailed (DataBox m) [DataBox (k, v), DataBox k, DataBox v]          (\cl (funcSameType, funcNewType) -> concat [            case cl of@@ -229,7 +234,7 @@        -- Must find types for contained types, in case they are not generated elsewhere.        findTypesIn (const Nothing) x        tk <- liftIO $ typeKey s-       modify (Map.insert tk (show $ typeOf s,+       modify (Map.insert tk (toQualName s,          Detailed (DataBox s) [DataBox x]          (\cl (funcSameType, funcNewType) -> concat [            case cl of@@ -382,21 +387,15 @@                       Plain {} -> Nothing                       Detailed _ contains _ -> Just contains     -    wName = show $ typeOf w+    (wName, wMod) = toQualNameMod w     wMunged = mungeName wName     wDType = dataTypeOf w     wCtrs = if isAlgType wDType then dataTypeConstrs wDType else [] -    -- The module prefix of this type, so we can use it in constructor names.-    modPrefix-        = if '.' `elem` (takeWhile (\c -> isAlphaNum c || c == '.') wName)-            then takeWhile (/= '.') wName ++ "."-            else ""-     ctrArgs ctr         = gmapQ DataBox (fromConstr ctr :: t)     ctrArgTypes types-        = [show $ typeOf w | DataBox w <- types]+        = [toQualName w | DataBox w <- types]      -- Given the context (a list of instance requirements), the left-hand ops,     -- the right-hand ops, and a list of lines for the body of the class, generates@@ -540,14 +539,14 @@       where         argNums = [0 .. ((length $ ctrArgs ctr) - 1)]         ctrS = show ctr-        ctrName = modPrefix ++ ctrS+        ctrName = wMod ++ ctrS         makeCtr vs = ctrName ++ concatMap (" " ++) vs         ctrInput = makeCtr ["a" ++ show i | i <- argNums]         ctrMod = makeCtr ["b" ++ show i | i <- argNums]      -- | An instance that describes how to apply -- or not apply -- a     -- transformation.-    otherInst :: Data s => Int -> Set.Set Int -> s -> Int -> [String]+    otherInst :: Data s => TypeRepKey -> Set.Set TypeRepKey -> s -> TypeRepKey -> [String]     otherInst wKey containedKeys c cKey         = if not shouldGen then [] else             genInst context@@ -555,7 +554,7 @@                     "ops"                     impl       where-        cName = show $ typeOf c+        cName = toQualName c         (shouldGen, context, impl)           -- This type matches the transformation: apply it.           | wKey == cKey@@ -582,7 +581,7 @@ -- | The lines in the header that form the import statements necessary for the -- Alloy instances. instanceImports :: [String]-instanceImports = map ("import " ++) ["Control.Applicative", "Control.Monad", "Data.Generics.Alloy"]+instanceImports = map ("import " ++) ["Control.Applicative", "Control.Monad", "Data.Generics.Alloy", "qualified GHC.Types"]  -- | Like 'instanceImports' but also adds the lines needed for maps and sets. -- If you use 'genMapInstance' or 'genSetInstance', use this function, otherwise@@ -656,12 +655,42 @@ instance Eq DataBox where   (==) (DataBox x) (DataBox y) = typeOf x == typeOf y --type TypeMap = Map Int (String, Witness)+type TypeMap = Map TypeRepKey (String, Witness) type TypeMapM = StateT TypeMap IO -typeKey :: Typeable t => t -> IO Int+typeKey :: Typeable t => t -> IO TypeRepKey typeKey x = typeRepKey $ typeOf x++toQualName :: Typeable t => t -> String+toQualName w = fst (toQualNameMod w)++-- First item is name of type, with everything inside qualified+-- Second item is the module prefix (if any) of the outermost type+toQualNameMod :: Typeable t => t -> (String, String)+toQualNameMod w = toQualNameMod' (typeOf w)++toQualNameMod' :: TypeRep -> (String, String)+toQualNameMod' tr = case (show con, args) of+  ("[]", [arg]) -> -- Lists are special case, don't qualify and use [ ] to wrap:+                ("[" ++ fst (toQualNameMod' arg) ++ "]", "")+  ("()", []) -> ("()", "") -- Unit is special, don't qualify+  ('(':',':_, args) -> -- Tuples are also special, don't qualify:+       ("(" ++ show con ++ concat (Prelude.map ((' ' :) . fst . toQualNameMod') args) ++ ")"+       , "")    +      -- Special case Integer, whose definition is hidden:+  _ | qualCon con == "GHC.Integer.Type.Integer" -> ("Prelude.Integer", "")+  _ -> ("(" ++ qualCon con ++ concat (Prelude.map ((' ' :) . fst . toQualNameMod') args) ++ ")"+       , modPrefix con)+  where+    (con, args) = splitTyConApp tr++qualCon :: TyCon -> String+qualCon wc = modPrefix wc ++ show wc++modPrefix :: TyCon -> String+modPrefix wc = case Ty.tyConModule wc of+                 "" -> ""+                 m -> m ++ "."  findTypesIn' :: Data t => (DataBox -> Maybe [DataBox]) -> t -> IO TypeMap findTypesIn' f x = execStateT (findTypesIn f x) Map.empty

@@ -189,7 +189,7 @@ infixr 7 :-@  -- | The terminator for opsets with 'AlloyARoute'.-data BaseOpARoute m outer = BaseOpARoute+data BaseOpARoute (m :: * -> *) outer = BaseOpARoute   -- | A handy synonym for a monadic/applicative opset with only one item, to use with 'AlloyARoute'.

@@ -1,9 +1,9 @@ Name: alloy-Version: 1.0.0+Version: 1.1.0 License: BSD3 License-File: LICENSE Author: Neil Brown and Adam Sampson-Copyright: Copyright 2008-2009, University of Kent+Copyright: Copyright 2008-2009, 2012 University of Kent Maintainer: neil@twistedsquare.com Cabal-Version: >= 1.2.3 Build-type: Simple@@ -30,10 +30,7 @@                     tutorial/Selective.lhs  Library-  if (impl(ghc < 6.10))-    Build-Depends: base >= 3 && < 4, containers, mtl-  else-    Build-Depends: base >= 4 && < 5, containers, mtl, syb+  Build-Depends:   base >= 4.3 && < 5, containers, mtl, syb    Exposed-modules: Data.Generics.Alloy                    Data.Generics.Alloy.Effect@@ -42,7 +39,8 @@                    Data.Generics.Alloy.Route                    Data.Generics.Alloy.Schemes -  Extensions: ExistentialQuantification+  Extensions: CPP+              ExistentialQuantification               FlexibleContexts               FlexibleInstances               KindSignatures

@@ -7,7 +7,7 @@ {-# LANGUAGE DeriveDataTypeable #-} module CompanyDatatypes where -import Data.Generics hiding (Unit)+import Data.Generics  -- The organisational structure of a company