some 1.0.0.2 → 1.0.0.3

raw patch · 4 files changed

+87/−6 lines, 4 filesdep +somedep ~base

Dependencies added: some

Dependency ranges changed: base

Files

• ChangeLog.md +5/−1
• some.cabal +15/−2
• src/Data/Some/Newtype.hs +5/−3
• test/HKD.hs +62/−0

@@ -1,6 +1,10 @@-# 1.0.0.2+# 1.0.0.3  - One less `unsafeCoerce` (thanks to David Feuer)++# 1.0.0.2++- Broken release  # 1.0.0.1 

@@ -1,9 +1,11 @@ name:               some-version:            1.0.0.2+version:            1.0.0.3 stability:          provisional cabal-version:      >=1.10 build-type:         Simple-author:             James Cook <mokus@deepbondi.net>, Oleg Grenrus <oleg.grenrus@iki.fi>+author:+  James Cook <mokus@deepbondi.net>, Oleg Grenrus <oleg.grenrus@iki.fi>+ maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi> license:            BSD3 license-file:       LICENSE@@ -19,6 +21,8 @@   @   .   in few variants, and utilities to work with it.+  .+  If you are unsure which variant to use, use the one in "Data.Some" module.  tested-with:   GHC ==7.0.4@@ -76,3 +80,12 @@         semigroups           >=0.18.5 && <0.20       , transformers         >=0.3    && <0.6       , transformers-compat  >=0.6    && <0.7++test-suite hkd-example+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          HKD.hs+  build-depends:+      base+    , some

@@ -82,16 +82,18 @@ -- newtype Some tag = UnsafeSome (tag Any)  +#if __GLASGOW_HASKELL__ >= 801+{-# COMPLETE Some #-}+pattern Some :: tag a -> Some tag #if __GLASGOW_HASKELL__ >= 802 pattern Some x <- UnsafeSome x   where Some x = UnsafeSome ((unsafeCoerce :: tag a -> tag Any) x)-#elif __GLASGOW_HASKELL__ >= 801+#else -- There was a bug type checking pattern synonyms that prevented the -- obvious thing from working.-{-# COMPLETE Some #-}-pattern Some :: tag a -> Some tag pattern Some x <- UnsafeSome ((unsafeCoerce :: tag Any -> tag a) -> x)   where Some x = UnsafeSome ((unsafeCoerce :: tag a -> tag Any) x)+#endif #endif  -- | Constructor.

@@ -0,0 +1,62 @@+{-# LANGUAGE CPP           #-}+{-# LANGUAGE GADTs         #-}+{-# LANGUAGE RankNTypes    #-}+{-# LANGUAGE TypeOperators #-}+module Main where++import Control.Applicative as A+import Data.Monoid as Mon++-- from Some package+import qualified Data.Some.Church  as C+import qualified Data.Some.GADT    as G+import qualified Data.Some.Newtype as N++class FFoldable t where+  ffoldMap :: Monoid m => (forall a. f a -> m) -> t f -> m++-- one derived operation, is ftraverse_, which we can implement using ffoldMap++gadt_ftraverse_ :: (FFoldable t, A.Applicative m) => (forall a. f a -> m b) -> t f -> m ()+gadt_ftraverse_ k tf = case ffoldMap (G.Some . k) tf of+  G.Some mx -> () <$ mx++newtype_ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m ()+#if __GLASGOW_HASKELL__ >= 801+newtype_ftraverse_ k tf = case ffoldMap (N.Some . k) tf of+  N.Some mx -> () <$ mx+#else+newtype_ftraverse_ k tf = N.withSome (ffoldMap (N.mkSome . k) tf) $+  \mx -> () <$ mx+#endif++church_ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m ()+church_ftraverse_ k tf = C.withSome (ffoldMap (C.mkSome . k) tf) $+  \mx -> () <$ mx++-- ghc -c -fforce-recomp -O -ddump-simpl -dsuppress-all HKD.hs++data Ex f where+    Nil :: Ex f+    Cons :: f a -> Ex f -> Ex f++instance FFoldable Ex where+    ffoldMap f = go where+        go Nil         = Mon.mempty+        go (Cons x xs) = mappend (f x) (go xs)++gadt_ftraverse_Ex :: Applicative m => (forall a. f a -> m b) -> Ex f -> m ()+gadt_ftraverse_Ex = gadt_ftraverse_++newtype_ftraverse_Ex :: Applicative m => (forall a. f a -> m b) -> Ex f -> m ()+newtype_ftraverse_Ex = newtype_ftraverse_++church_ftraverse_Ex :: Applicative m => (forall a. f a -> m b) -> Ex f -> m ()+church_ftraverse_Ex = church_ftraverse_++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = return ()