packages feed

coercible-utils (empty) → 0.0.0

raw patch · 7 files changed

+356/−0 lines, 7 filesdep +basedep +coercible-utilsdep +gaugesetup-changed

Dependencies added: base, coercible-utils, gauge

Files

+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog+`coercible-utils` uses [PVP Versioning][PVP].++## [0.0.0] – 2018-06-29+Initial release.+++[Unreleased]: https://github.com/sjakobi/coercible-utils/compare/v0.0.0...HEAD+[0.0.0]: https://github.com/sjakobi/coercible-utils/releases/tag/v0.0.0++[PVP]: https://pvp.haskell.org+
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2018, Simon Jakobi+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Main.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE BangPatterns #-}++{-# OPTIONS_GHC -O2 #-}++module Main (main) where++import CoercibleUtils+import Data.Monoid (Sum(..))+import Gauge.Main+import Prelude hiding (sum)+import qualified Data.List as List+import qualified Data.Foldable as Foldable++main :: IO ()+main = do+  let nums10, nums100, nums1000, nums10000, nums100000 :: [Int]+      nums10 = [1..10]+      nums100 = [1..100]+      nums1000 = [1..1000]+      nums10000 = [1..10000]+      nums100000 = [1..100000]+  +  defaultMain+    [ bgroup  "lazy sums"+      [ bench "CoercibleUtils.sum:     10"  $ whnf      sumLazy nums10+      , bench "Data.List.sum:          10"  $ whnf List.sum     nums10+      , bench "CoercibleUtils.sum:    100"  $ whnf      sumLazy nums100+      , bench "Data.List.sum:         100"  $ whnf List.sum     nums100+      , bench "CoercibleUtils.sum:   1000"  $ whnf      sumLazy nums1000+      , bench "Data.List.sum:        1000"  $ whnf List.sum     nums1000+      , bench "CoercibleUtils.sum:  10000"  $ whnf      sumLazy nums10000+      , bench "Data.List.sum:       10000"  $ whnf List.sum     nums10000+      , bench "CoercibleUtils.sum: 100000"  $ whnf      sumLazy nums100000+      , bench "Data.List.sum:      100000"  $ whnf List.sum     nums100000+      ]+    +    , bgroup  "strict sums"+      [ bench "CoercibleUtils.sum:     10"  $ whnf      sum nums10+      , bench "Data.List.sum:          10"  $ whnf List.sum nums10+      , bench "CoercibleUtils.sum:    100"  $ whnf      sum nums100+      , bench "Data.List.sum:         100"  $ whnf List.sum nums100+      , bench "CoercibleUtils.sum:   1000"  $ whnf      sum nums1000+      , bench "Data.List.sum:        1000"  $ whnf List.sum nums1000+      , bench "CoercibleUtils.sum:  10000"  $ whnf      sum nums10000+      , bench "Data.List.sum:       10000"  $ whnf List.sum nums10000+      , bench "CoercibleUtils.sum: 100000"  $ whnf      sum nums100000+      , bench "Data.List.sum:      100000"  $ whnf List.sum nums100000+      ]+    ]++sumLazy :: Num a => [a] -> a+{-# INLINE sumLazy #-}+sumLazy xs = ala Sum foldMap xs++sum :: Num a => [a] -> a+{-# INLINE sum #-}+sum xs = ala Sum foldMap' xs++foldMap' :: (Foldable t, Monoid m) => (a -> m) -> t a -> m+{-# INLINE foldMap' #-}+foldMap' f = Foldable.foldl' (\acc x -> acc `mappend` f x) mempty++
+ coercible-utils.cabal view
@@ -0,0 +1,53 @@+name:                coercible-utils+version:             0.0.0+description:         Utility functions for Coercible types.+synopsis:            Utility functions for Coercible types.+homepage:            https://github.com/sjakobi/coercible-utils+bug-reports:         https://github.com/sjakobi/coercible-utils/issues+license:             BSD3+license-file:        LICENSE+author:              Simon Jakobi, chessai+maintainer:          simon.jakobi@gmail.com+copyright:           2018 Simon Jakobi, chessai+category:            Control+build-type:          Simple+extra-doc-files:     CHANGELOG.md+cabal-version:       1.24+tested-with:         GHC == 7.10.3+                   , GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.3++library+  hs-source-dirs:      src+  exposed-modules:     CoercibleUtils+                       +  ghc-options:         -Wall+  build-depends:       base >= 4.8 && < 4.13+                     +  default-language:    Haskell2010+  +test-suite coercible-utils-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , coercible-utils+                     +  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++benchmark coercible-utils-benchmark+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  ghc-options:         -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+  hs-source-dirs:      benchmark+  main-is:             Main.hs+  build-depends:       base+                     , gauge+                     +                     , coercible-utils++source-repository head+  type:                git+  location:            https://github.com/sjakobi/coercible-utils.git
+ src/CoercibleUtils.hs view
@@ -0,0 +1,194 @@+{- |+Primarily pulled from the+package @[newtype-generics](http://hackage.haskell.org/package/newtype-generics)@,+and based on Conor McBride's Epigram work, but+generalised to work over anything `Coercible`.++>>> ala Sum foldMap [1,2,3,4 :: Int] :: Int+10++>>> ala Endo foldMap [(+1), (+2), (subtract 1), (*2) :: Int -> Int] (3 :: Int) :: Int+8++>>> under2 Min (<>) 2 (1 :: Int) :: Int+1++>>> over All not (All False) :: All+All {getAll = True)++__Note__: All of the functions in this module take an argument that solely+directs the /type/ of the coercion. The value of this argument is /ignored/.+-}+module CoercibleUtils+  ( -- * Coercive composition+    (#.), (.#)++    -- * The classic "newtype" combinators+  , op+  , ala, ala'+  , under, over+  , under2, over2+  , underF, overF+  ) where++import Data.Coerce (Coercible, coerce)++-- | Coercive left-composition.+--+-- >>> (All #. not) True+-- All {getAll = False}+--+-- The semantics with respect to bottoms are:+--+-- @+-- p '#.' ⊥ ≡ ⊥+-- p '#.' f ≡ p '.' f+-- @+infixr 9 #.+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(#.) _ = coerce+{-# INLINE (#.) #-}++-- | Coercive right-composition.+--+-- >>> (stimes 2 .# Product) 3+-- Product {getProduct = 9}+--+-- The semantics with respect to bottoms are:+--+-- @+-- ⊥ '.#' p ≡ ⊥+-- f '.#' p ≡ p '.' f+-- @+infixr 9 .#+(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c+(.#) f _ = coerce f+{-# INLINE (.#) #-}++-- | Reverse the type of a "packer".+--+-- >>> op All (All True)+-- True+-- >>> op (Identity . Sum) (Identity (Sum 3))+-- 3+op :: Coercible a b+   => (a -> b)+   -> b+   -> a+op = coerce+{-# INLINE op #-}++-- | The workhorse of the package. Given a "packer" and a \"higher order function\" (/hof/),+-- it handles the packing and unpacking, and just sends you back a regular old+-- function, with the type varying based on the /hof/ you passed.+--+-- The reason for the signature of the /hof/ is due to 'ala' not caring about structure.+-- To illustrate why this is important, consider this alternative implementation of 'under2':+--+-- @+-- under2' :: (Coercible a b, Coercible a' b')+--         => (a -> b) -> (b -> b -> b') -> (a -> a -> a')+-- under2' pa f o1 o2 = 'ala' pa (\\p -> uncurry f . bimap p p) (o1, o2)+-- @+--+-- Being handed the "packer", the /hof/ may apply it in any structure of its choosing –+-- in this case a tuple.+--+-- >>> ala Sum foldMap [1,2,3,4 :: Int] :: Int+-- 10+ala :: (Coercible a b, Coercible a' b')+    => (a -> b)+    -> ((a -> b) -> c -> b')+    -> c+    -> a'+ala pa hof = ala' pa hof id+{-# INLINE ala #-}++-- | The way it differs from the 'ala' function in this package,+--   is that it provides an extra hook into the \"packer\" passed to the hof.+-- +--   However, this normally ends up being 'id', so 'ala' wraps this function and+--   passes 'id' as the final parameter by default.+--   If you want the convenience of being able to hook right into the /hof/,+--   you may use this function.+--+-- >>> ala' Sum foldMap length ["hello", "world"] :: Int+-- 10+--+-- >>> ala' First foldMap (readMaybe @Int) ["x", "42", "1"] :: Maybe Int+-- Just 42+ala' :: (Coercible a b, Coercible a' b')+     => (a -> b)+     -> ((d -> b) -> c -> b')+     -> (d -> a)+     -> c+     -> a'+ala' _ hof f = coerce #. hof (coerce f)+{-# INLINE ala' #-}++-- | A very simple operation involving running the function /under/ the "packer".+--+-- >>> under Product (stimes 3) (3 :: Int) :: Int+-- 27+under :: (Coercible a b, Coercible a' b')+      => (a -> b)+      -> (b -> b')+      -> a+      -> a'+under _ f = coerce f+{-# INLINE under #-}++-- | The opposite of 'under'. I.e., take a function which works on the+--   underlying "unpacked" types, and switch it to a function that works+--   on the "packer".+--+-- >>> over All not (All False) :: All+-- All {getAll = True}+over :: (Coercible a b, Coercible a' b')+     => (a -> b)+     -> (a -> a')+     -> b+     -> b'+over _ f = coerce f+{-# INLINE over #-}++-- | Lower a binary function to operate on the underlying values.+--+-- >>> under2 Any (<>) True False :: Bool+-- True+under2 :: (Coercible a b, Coercible a' b')+       => (a -> b)+       -> (b -> b -> b')+       -> a+       -> a+       -> a'+under2 _ f = coerce f+{-# INLINE under2 #-}++-- | The opposite of 'under2'.+over2 :: (Coercible a b, Coercible a' b')+      => (a -> b)+      -> (a -> a -> a')+      -> b+      -> b+      -> b'+over2 _ f = coerce f+{-# INLINE over2 #-}++-- | 'under' lifted into a 'Functor'.+underF :: (Coercible a b, Coercible a' b', Functor f, Functor g)+       => (a -> b)+       -> (f b -> g b')+       -> f a+       -> g a'+underF _ f = fmap coerce . f . fmap coerce+{-# INLINE underF #-}++-- | 'over' lifted into a 'Functor'.+overF :: (Coercible a b, Coercible a' b', Functor f, Functor g)+      => (a -> b)+      -> (f a -> g a')+      -> f b+      -> g b'+overF _ f = fmap coerce . f . fmap coerce+{-# INLINE overF #-}
+ test/Spec.hs view
@@ -0,0 +1,3 @@+main :: IO ()+main = putStrLn ("Test suite not yet implemented" :: String)+