freer-simple 1.2.0.0 → 1.2.1.0

raw patch · 4 files changed

+61/−28 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• freer-simple.cabal +5/−4
• src/Control/Monad/Freer/TH.hs +35/−24
• tests/Tests/TH.hs +17/−0

@@ -1,3 +1,7 @@+# 1.2.1.0 (November 15th, 2018)++- Improved `makeEffect` from `Control.Monad.Freer.TH` to support more datatypes ([#17](https://github.com/lexi-lambda/freer-simple/pull/17)).+ # 1.2.0.0 (October 23rd, 2018)  - Added `Control.Monad.Freer.TH`, which provides a `makeEffect` function that automatically generates boilerplate operations using `send` for an effect ([#15](https://github.com/lexi-lambda/freer-simple/pull/15)).

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack ----- hash: 4f06465ab3fa36c72dff4e9197bc984c95dc787f823d64bf28f26b1a73a33a54+-- hash: 0ba678e5d0a715623f72dc54fdcfd0dae99df0524ca7b6538675b238e8fa7472  name:           freer-simple-version:        1.2.0.0+version:        1.2.1.0 synopsis:       Implementation of a friendly effect system for Haskell. description:    An implementation of an effect system for Haskell (a fork of                 <http://hackage.haskell.org/package/freer-effects freer-effects>), which is@@ -29,7 +31,6 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:     CHANGELOG.md     README.md

@@ -36,8 +36,6 @@ import Control.Monad (forM, unless) import Control.Monad.Freer (send, Member, Eff) import Data.Char (toLower)-import Data.List (nub)-import Data.Maybe (mapMaybe) import Language.Haskell.TH import Prelude @@ -110,41 +108,54 @@     [] genDecl _ = fail "genDecl expects a GADT constructor" --- | Generates a type signature of the form+-- | Generates a function type from the corresponding GADT type constructor -- @x :: Member (Effect e) effs => a -> b -> c -> Eff effs r@.-genSig :: Con -> Q Dec-genSig (ForallC _       _      con                    ) = genSig con-genSig (GadtC   [cName] tArgs' ctrType@(AppT eff tRet)) = do+genType :: Con -> Q Type+genType (ForallC tyVarBindings conCtx con)+  = ForallT tyVarBindings conCtx <$> genType con+genType (GadtC   _ tArgs' (AppT eff tRet)) = do   effs <- newName "effs"   let-    fnName    = getDeclName cName-    tArgs     = fmap snd tArgs'-    otherVars = unapply ctrType-    quantifiedVars =-      fmap PlainTV . nub $ effs : mapMaybe freeVarName (tArgs ++ otherVars)+    tArgs            = fmap snd tArgs'     memberConstraint = ConT ''Member `AppT` eff `AppT` VarT effs     resultType       = ConT ''Eff `AppT` VarT effs `AppT` tRet    return-    .  SigD fnName-    .  ForallT quantifiedVars [memberConstraint]+    .  ForallT [PlainTV effs] [memberConstraint]     .  foldArrows     $  tArgs     ++ [resultType] -- TODO: Although this should never happen, we obviously need a better error message below.-genSig GadtC{} = fail "genSig can only look at applications (AppT)"-genSig _       = fail "genSig expects a GADT constructor"+genType _       = fail "genSig expects a GADT constructor" --- | Gets the name of the free variable in the 'Type', if it exists.-freeVarName :: Type -> Maybe Name-freeVarName (VarT n) = Just n-freeVarName _        = Nothing+-- | Turn all (KindedTV tv StarT) into (PlainTV tv) in the given type+-- This can prevent the need for KindSignatures+simplifyBndrs :: Type -> Type+simplifyBndrs (ForallT bndrs tcxt t) = ForallT (map simplifyBndr bndrs) tcxt (simplifyBndrs t)+simplifyBndrs (AppT t1 t2) = AppT (simplifyBndrs t1) (simplifyBndrs t2)+simplifyBndrs (SigT t k) = SigT (simplifyBndrs t) k+simplifyBndrs (InfixT t1 n t2) = InfixT (simplifyBndrs t1) n (simplifyBndrs t2)+simplifyBndrs (UInfixT t1 n t2) = InfixT (simplifyBndrs t1) n (simplifyBndrs t2)+simplifyBndrs (ParensT t) = ParensT (simplifyBndrs t)+simplifyBndrs t = t +-- | Turn TvVarBndrs of the form (KindedTV tv StarT) into (PlainTV tv)+-- This can prevent the need for KindSignatures+simplifyBndr :: TyVarBndr -> TyVarBndr+simplifyBndr (KindedTV tv StarT) = PlainTV tv+simplifyBndr bndr = bndr++-- | Generates a type signature of the form+-- @x :: Member (Effect e) effs => a -> b -> c -> Eff effs r@.+genSig :: Con -> Q Dec+genSig con = do+  let+    getConName (ForallC _ _ c) = getConName c+    getConName (GadtC [n] _ _) = pure n+    getConName c = fail $ "failed to get GADT name from " ++ show c+  conName <- getConName con+  SigD (getDeclName conName) <$> simplifyBndrs <$> genType con+ -- | Folds a list of 'Type's into a right-associative arrow 'Type'. foldArrows :: [Type] -> Type foldArrows = foldr1 (AppT . AppT ArrowT)---- | Unfolds a type into any types which were applied together.-unapply :: Type -> [Type]-unapply (AppT a b) = unapply a ++ unapply b-unapply a          = [a]

@@ -32,3 +32,20 @@  testGeneratedFunction :: String -> String testGeneratedFunction s = run . runPrepender $ prependSomething s++-- Create a more complicated test GADT+data Complicated a where+  Mono :: Int -> Complicated Bool+  Poly :: a -> Complicated a+  PolyIn :: a -> Complicated Bool+  PolyOut :: Int -> Complicated a+  Lots :: a -> b -> c -> d -> e -> f -> Complicated ()+  Nested :: Maybe b -> Complicated (Maybe a)+  MultiNested :: (Maybe a, [b]) -> Complicated (Maybe a, [b])+  Existential :: (forall e. e -> Maybe e) -> Complicated a+  LotsNested :: Maybe a -> [b] -> (c, c) -> Complicated (a, b, c)+  Dict :: (Ord a) => a -> Complicated a+  MultiDict :: (Eq a, Ord b, Enum a, Num c) => a -> b -> c -> Complicated ()++-- Make TH generate our effect functions.+makeEffect ''Complicated