diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# THEff + This package implements effects, as alternative to monad + transformers. Actually, the effects themselves are created without + the use of TH, but the binding of nested effects described by + mkEff splice. + For more information about extensible effects , see the original paper at + . + But, this package is significantly different from the original. + It uses a chains of ordinary GADTs created by TH. + No Typeable, unsafe... , ExistentialQuantification ... + diff --git a/THEff.cabal b/THEff.cabal --- a/THEff.cabal +++ b/THEff.cabal @@ -1,5 +1,5 @@ name: THEff -version: 0.1.1.0 +version: 0.1.3 synopsis: TH implementation of effects. license: BSD3 license-file: LICENSE @@ -35,16 +35,19 @@ . But, this package is significantly different from the original. It uses a chains of ordinary GADTs created by TH. - No Typeable, unsafe... , ExistentialQuantification ... + No Typeable, no unsafe... , no ExistentialQuantification ... -extra-source-files: samples/*.hs +extra-source-files: + README.md + changelog + samples/*.hs Source-repository head type: git location: https://github.com/KolodeznyDiver/THEff.git library - ghc-options: -Wall + ghc-options: -Wall -O2 -fwarn-tabs exposed-modules: Control.THEff Control.THEff.Reader Control.THEff.State @@ -74,8 +77,8 @@ , BangPatterns -- Other library packages from which modules are imported. - build-depends: base >=4.8 && <4.9 - ,template-haskell >=2.4 && <2.11 + build-depends: base >= 4.7 && < 5 + ,template-haskell >=2.11 -- Directories containing source files. hs-source-dirs: src diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,6 @@ +THEff 0.1.3 (released 2017-01-22) + * some redundant constraints eliminated +THEff 0.1.2 (released 2017-01-22) + * ghc 8.x compatable + + diff --git a/samples/SampleAll.hs b/samples/SampleAll.hs --- a/samples/SampleAll.hs +++ b/samples/SampleAll.hs @@ -15,7 +15,6 @@ import Control.THEff.Validator import System.Environment (getProgName) import Control.Monad -import Data.Either import GHC.Float mkEff "MyReader" ''Reader ''Int ''Lift @@ -55,4 +54,4 @@ x <- chk $ fromIntegral i * f -- MyVldtr return $ float2Double x return $ either ((++ " is out of range") . show) show r - print r + print r diff --git a/samples/SampleException.hs b/samples/SampleException.hs --- a/samples/SampleException.hs +++ b/samples/SampleException.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -{-# # LANGUAGE ScopedTypeVariables #-} module Main where import Control.THEff diff --git a/samples/SampleReader.hs b/samples/SampleReader.hs --- a/samples/SampleReader.hs +++ b/samples/SampleReader.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -{-# # LANGUAGE ScopedTypeVariables #-} module Main where import Control.THEff diff --git a/samples/SampleValidator.hs b/samples/SampleValidator.hs --- a/samples/SampleValidator.hs +++ b/samples/SampleValidator.hs @@ -2,25 +2,26 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -{-# # LANGUAGE ScopedTypeVariables #-} module Main where import Control.THEff import Control.THEff.Validator -mkEff "MyVldtr" ''Validator ''Float ''NoEff +mkEff "MyValidator" ''Validator ''Float ''NoEff test1 :: Int -> Either Float Float -- return Left if out of range -test1 i = runMyVldtr (validator (<30)) $ +test1 i = runMyValidator (validator (<30)) $ chk $ pi ^ i test2 :: Int -> Float -- If value is out of range, it is set on the border of the range. -- test2 i = right $ runMyVldtr (range 0 30) $ chk $ pi ^ i -test2 i = withRange runMyVldtr 0 30 $ chk $ pi ^ i +test2 i = withRange runMyValidator 0 30 $ do + let checkValue = pi ^ i + chk checkValue main:: IO () main = do print $ test1 2 print $ test1 3 print $ test2 2 - print $ test2 3 + print $ test2 3 diff --git a/samples/SampleWriter.hs b/samples/SampleWriter.hs --- a/samples/SampleWriter.hs +++ b/samples/SampleWriter.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -{-# # LANGUAGE ScopedTypeVariables #-} module Main where import Control.THEff @@ -23,4 +22,4 @@ forM_ [1::Int .. 10] (tell . Sum) return (pi :: Float) - return $ show $ r * fromIntegral v + return $ show $ r * fromIntegral v diff --git a/src/Control/THEff.hs b/src/Control/THEff.hs --- a/src/Control/THEff.hs +++ b/src/Control/THEff.hs @@ -127,7 +127,7 @@ toEffM:: Lift' m e -> e -- | Lift a Monad to an Effect. -lift:: (Monad m, EffClassM m e) => m a -> Eff e a +lift:: EffClassM m e => m a -> Eff e a lift m = effLift $ Lift' m id -- | The first effect in a chain of monadic effects. diff --git a/src/Control/THEff/Reader.hs b/src/Control/THEff/Reader.hs --- a/src/Control/THEff/Reader.hs +++ b/src/Control/THEff/Reader.hs @@ -27,7 +27,7 @@ -- > s <- ask -- > return $ c:s -- --- __/Output :/__ "Test" +-- __/Output :/__ \"Test\" -- * Types and functions used in mkEff Reader' diff --git a/src/Control/THEff/Reader/Strict.hs b/src/Control/THEff/Reader/Strict.hs --- a/src/Control/THEff/Reader/Strict.hs +++ b/src/Control/THEff/Reader/Strict.hs @@ -28,7 +28,7 @@ -- > s <- ask -- > return $ c:s -- --- __/Output :/__ "Test" +-- __/Output :/__ \"Test\" -- * Types and functions used in mkEff Reader' diff --git a/src/Control/THEff/TH/Internal.hs b/src/Control/THEff/TH/Internal.hs --- a/src/Control/THEff/TH/Internal.hs +++ b/src/Control/THEff/TH/Internal.hs @@ -24,7 +24,7 @@ getModuleAndName = splitLast '.' . show parseCon :: Con -> Either String DescrEff -parseCon (NormalC n [(NotStrict, AppT t@(AppT (ConT e) _) _ )]) = +parseCon (NormalC n [(Bang _ _, AppT t@(AppT (ConT e) _) _ )]) = if not (null en) && last en == '\'' then Right $ DescrEff nm nn' em (init en) (if en == "Lift'" then Nothing else Just t) else Left $ "Incorrect type name : " ++ en @@ -46,18 +46,20 @@ mkTypePrim newType lst = do m <- newName "m" e <- newName "e" - let kinds = [KindedTV m (AppT (AppT ArrowT StarT) StarT), KindedTV e StarT] + let kinds = [KindedTV m (AppT (AppT ArrowT StarT) StarT), PlainTV e] let n = mkPrimName newType let mkc = mkCon (VarT m) (VarT e) newType return $ case lst of - [d] -> NewtypeD [] n kinds (mkc d) [] - _ -> DataD [] n kinds (map mkc lst) [] - - + [d] -> NewtypeD [] n kinds Nothing (mkc d) [] + _ -> DataD [] n kinds Nothing (map mkc lst) [] + +bangNotStrict:: Bang +bangNotStrict = Bang NoSourceUnpackedness NoSourceStrictness + mkCon :: Type -> Type -> String -> DescrEff -> Con mkCon m e newType d@DescrEff{..} = - NormalC (mkN_E newType dName) [(NotStrict, AppT + NormalC (mkN_E newType dName) [(bangNotStrict, AppT ( case dType of (Just t) -> t _ -> AppT (ConT $ mkEffName' d) m @@ -71,10 +73,9 @@ let t' = mkPrimName $ thisMdl ++ newType let u = mkName $ "un" ++ newType return $ - NewtypeD [] n [KindedTV m (AppT (AppT ArrowT StarT) StarT), - KindedTV a StarT] + NewtypeD [] n [KindedTV m (AppT (AppT ArrowT StarT) StarT), PlainTV a] Nothing (RecC n - [(u,NotStrict, + [(u,bangNotStrict, AppT (AppT (AppT (AppT (AppT (ConT effName) (VarT m)) (AppT (AppT (ConT newTypeName) (VarT m)) @@ -113,7 +114,7 @@ a <- newName "a" x <- newName "x" let fullNewType = thisMdl ++ newType - return $ InstanceD [] (AppT + return $ InstanceD Nothing [] (AppT (case dType of (Just (AppT effT argT)) -> AppT (AppT (ConT c) effT) argT _ -> AppT (ConT c) (VarT m) @@ -133,8 +134,8 @@ (TyConI d) <- reify t return (case d of (TySynD _ [_,_] _) -> True - (NewtypeD [] _ [_,_] _ _) -> True - (DataD _ _ [_,_] _ _) -> True + (NewtypeD [] _ [_,_] _ _ _) -> True + (DataD _ _ [_,_] _ _ _) -> True _ -> False ) @@ -155,7 +156,7 @@ (AppT -- arg 5 (AppT ArrowT (AppT (AppT (ConT _) (VarT _)) (VarT _))) (AppT (VarT _) _ - ))))))) _ _ ) -> True + ))))))) _ ) -> True _ -> False resTName <- lookEffType $ concat [tm,tn,"ResT"] m <- newName "m" @@ -249,8 +250,8 @@ else do oi <- reify outt case oi of - TyConI (NewtypeD [] _ [_,_] (RecC (ocmp -> True) - [(_,NotStrict, + TyConI (NewtypeD [] _ [_,_] _ (RecC (ocmp -> True) + [(_,Bang _ _, AppT (AppT (AppT (AppT (AppT (ConT te) _ ) _ ) @@ -263,8 +264,8 @@ opi <- reify tep let ~(TyConI dec) = opi let lst = case dec of - (NewtypeD [] _ [_,_] c []) -> [parseCon c] - (DataD [] _ [_,_] cl []) -> map parseCon cl + (NewtypeD [] _ [_,_] _ c []) -> [parseCon c] + (DataD [] _ [_,_] _ cl []) -> map parseCon cl _ -> [Left $ "Incorrect type " ++ show tep] case lefts lst of diff --git a/src/Control/THEff/Validator.hs b/src/Control/THEff/Validator.hs --- a/src/Control/THEff/Validator.hs +++ b/src/Control/THEff/Validator.hs @@ -107,7 +107,7 @@ chk v = effValidator $ Validator' v id -- | validator returns __/Right v/__ if the predicate returns True and __/Left v/__ else. -validator :: Ord v => +validator :: (v -> Bool) -- ^ predicate -> v -- ^ value -> Either v v diff --git a/src/Control/THEff/Writer.hs b/src/Control/THEff/Writer.hs --- a/src/Control/THEff/Writer.hs +++ b/src/Control/THEff/Writer.hs @@ -18,7 +18,6 @@ -- > import Control.THEff -- > import Control.THEff.Writer -- > import Control.Monad(forM_) --- > import Data.Monoid -- > -- > type IntAccum = Sum Int -- > @@ -52,7 +51,6 @@ ) where import Control.THEff -import Data.Monoid -- | Actually, the effect type -- - __/v/__ - Type - the parameter of the effect. diff --git a/src/Control/THEff/Writer/Strict.hs b/src/Control/THEff/Writer/Strict.hs --- a/src/Control/THEff/Writer/Strict.hs +++ b/src/Control/THEff/Writer/Strict.hs @@ -19,7 +19,6 @@ -- > import Control.THEff -- > import Control.THEff.Writer.Strict -- > import Control.Monad(forM_) --- > import Data.Monoid -- > -- > type IntAccum = Sum Int -- > @@ -53,7 +52,6 @@ ) where import Control.THEff -import Data.Monoid -- | Actually, the effect type -- - __/v/__ - Type - the parameter of the effect.