extensible-skeleton 0 → 0.0.1

raw patch · 6 files changed

+78/−13 lines, 6 filesdep +extensible-skeletondep ~extensibledep ~monad-skeletonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: extensible-skeleton

Dependency ranges changed: extensible, monad-skeleton

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• extensible-skeleton.cabal +8/−5
• src/Data/Extensible/Effect.hs +1/−2
• src/Data/Extensible/Effect/Default.hs +6/−1
• src/Data/Extensible/Effect/TH.hs +31/−4
• tests/effects.hs +28/−1

@@ -0,0 +1,4 @@+## 0.0.1++* Supported GHC 9.0 / template-haskell-2.17+* Added `runIODef`

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                extensible-skeleton-version:             0+version:             0.0.1 synopsis:            Operational-based extensible effect library homepage:            https://github.com/fumieval/extensible bug-reports:         http://github.com/fumieval/extensible/issues@@ -9,13 +9,14 @@ license-file:        LICENSE author:              Fumiaki Kinoshita maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>-copyright:           Copyright (c) 2019 Fumiaki Kinoshita+copyright:           Copyright (c) 2021 Fumiaki Kinoshita category:            Monads build-type:          Simple stability:           experimental-Tested-With:         GHC == 8.4.4, GHC == 8.6.3+Tested-With:         GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4, GHC == 9.0.1  extra-source-files:+  CHANGELOG.md  source-repository head   type: git@@ -23,7 +24,9 @@  library   build-depends: base >= 4.8 && <5-    , extensible >= 0.6.2, monad-skeleton, resourcet, membership, transformers, mtl+    , extensible ^>= 0.8+    , monad-skeleton ^>= 0.1+    , resourcet, membership, transformers, mtl     , exceptions, profunctors, template-haskell   exposed-modules:     Data.Extensible.Effect@@ -44,6 +47,6 @@ test-suite effects   type: exitcode-stdio-1.0   main-is: effects.hs-  build-depends: base, extensible+  build-depends: base, extensible, extensible-skeleton   hs-source-dirs: tests   default-language:    Haskell2010

@@ -97,7 +97,6 @@ import Data.Extensible.Class import Data.Kind (Type) import Data.Functor.Identity-import Data.Profunctor.Unsafe -- Trustworthy since 7.8 import Data.Type.Equality import Type.Membership @@ -205,7 +204,7 @@ -- | Process an 'Eff' action using a record of 'Interpreter's. handleEff :: RecordOf (Interpreter m) xs -> Eff xs a -> MonadView m (Eff xs) a handleEff hs m = case debone m of-  Instruction i t :>>= k -> views (pieceAt i) (runInterpreter .# getField) hs t :>>= k+  Instruction i t :>>= k -> views (pieceAt i) (\(Field (Interpreter x)) -> x) hs t :>>= k   Return a -> Return a  -- | Anonymous representation of instructions.

@@ -15,7 +15,8 @@ -- 'MonadState', 'MonadError' instances ----------------------------------------------------------------------------- module Data.Extensible.Effect.Default (-  ReaderDef+  runIODef+  , ReaderDef   , runReaderDef   , StateDef   , runStateDef@@ -48,6 +49,10 @@  instance (MonadIO m, Lookup xs "IO" m) => MonadIO (Eff xs) where   liftIO = liftEff (Proxy :: Proxy "IO") . liftIO++-- | 'retractEff' specialised for IO+runIODef :: Eff '["IO" ':> IO] a -> IO a+runIODef = retractEff  #if MIN_VERSION_resourcet(1,2,0) instance (MonadResource m, Lookup xs "IO" m) => MonadResource (Eff xs) where

@@ -1,8 +1,10 @@ {-# LANGUAGE Trustworthy, TemplateHaskell, LambdaCase, ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-} ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Effect.TH--- Copyright   :  (c) Fumiaki Kinoshita 2019+-- Copyright   :  (c) Fumiaki Kinoshita 2021 -- License     :  BSD3 -- -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>@@ -62,13 +64,23 @@     -> do       (cxts, dcs) <- fmap unzip $ traverse (con2Eff tparams) cs -      let vars = map PlainTV $ nub $ concatMap (varsT . snd) cxts+      let vars = map mkPlainTV $ nub $ concatMap (varsT . snd) cxts       return $ [TySynD dataName vars (typeListT $ map snd cxts) | synSet]-          ++ [ TySynD k (map PlainTV $ nub $ varsT t) t | synActions, (k, t) <- cxts]+          ++ [ TySynD k (map mkPlainTV $ nub $ varsT t) t | synActions, (k, t) <- cxts]           ++ concat dcs   _ -> fail "mkEffects accepts GADT declaration"+  where+#if MIN_VERSION_template_haskell(2,17,0)+    mkPlainTV n = PlainTV n ()+#else+    mkPlainTV = PlainTV+#endif +#if MIN_VERSION_template_haskell(2,17,0)+con2Eff :: [TyVarBndr ()] -> Con -> Q ((Name, Type), [Dec])+#else con2Eff :: [TyVarBndr] -> Con -> Q ((Name, Type), [Dec])+#endif con2Eff _ (GadtC [name] st (AppT _ resultT))   = return $ effectFunD name (map snd st) resultT con2Eff tparams (ForallC _ eqs (NormalC name st))@@ -78,12 +90,21 @@   runIO (print p)   fail "Unsupported constructor" +#if MIN_VERSION_template_haskell(2,17,0)+fromMangledGADT :: [TyVarBndr ()] -> [Type] -> Name -> [(Strict, Type)] -> ((Name, Type), [Dec])+#else fromMangledGADT :: [TyVarBndr] -> [Type] -> Name -> [(Strict, Type)] -> ((Name, Type), [Dec])+#endif fromMangledGADT tyvars_ eqs con fieldTypes   = effectFunD con argumentsT result   where+#if MIN_VERSION_template_haskell(2,17,0)+    getTV (PlainTV n _) = n+    getTV (KindedTV n _ _) = n+#else     getTV (PlainTV n) = n     getTV (KindedTV n _) = n+#endif      tyvars = map getTV tyvars_ @@ -123,7 +144,13 @@      fName = let (ch : rest) = nameBase key in mkName $ toLower ch : rest -    typ = ForallT (map PlainTV $ varList : varsT resultT ++ concatMap varsT argumentsT)+#if MIN_VERSION_template_haskell(2,17,0)+    mkPlainTV n = PlainTV n SpecifiedSpec+#else+    mkPlainTV = PlainTV+#endif++    typ = ForallT (map mkPlainTV $ varList : varsT resultT ++ concatMap varsT argumentsT)         [associateT nameT actionT varList]         $ effectFunT varList argumentsT resultT 

@@ -1,6 +1,11 @@ {-# LANGUAGE GADTs, DataKinds, FlexibleContexts, TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -ddump-splices #-}-import Data.Extensible+module Main where+import Control.Monad.IO.Class+import Data.Extensible.Effect+import Data.Extensible.Effect.TH+import Data.Extensible.Effect.Default  decEffects [d|   data Example a b x where@@ -19,4 +24,26 @@     Simple :: Simple ()   |] +handleSimple :: MonadIO (Eff xs) => Eff (Simple ': xs) a -> Eff xs a+handleSimple = peelAction0 (liftIO (putStrLn "hello"))++handleConcrete :: MonadIO (Eff xs) => Eff (Concrete ': xs) a -> Eff xs a+handleConcrete = peelAction0 (\i -> liftIO (print i))++handlePolyArg :: (Show a, MonadIO (Eff xs)) => Eff (PolyArg a ': xs) a -> Eff xs a+handlePolyArg = peelAction0 (\i -> liftIO (print i))++handlePolyRes :: (Monoid a, MonadIO (Eff xs)) => Eff (PolyRes a ': xs) a -> Eff xs a+handlePolyRes = peelAction0 (pure mempty)++handleUnboundArg :: (Monoid a, MonadIO (Eff xs)) => Eff (UnboundArg a ': xs) a -> Eff xs a+handleUnboundArg = peelAction0 (\_ -> pure ())++handleUnboundRes :: (Monoid a, MonadIO (Eff xs)) => Eff (UnboundRes a ': xs) a -> Eff xs a+handleUnboundRes = peelAction0 (pure mempty)++ex_simple :: IO ()+ex_simple = runIODef $ handleSimple simple++main :: IO () main = return ()