packages feed

coercible-utils 0.0.0 → 0.1.0

raw patch · 7 files changed

+517/−198 lines, 7 filesdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

- CoercibleUtils: ala :: (Coercible a b, Coercible a' b') => (a -> b) -> ((a -> b) -> c -> b') -> c -> a'
- CoercibleUtils: ala' :: (Coercible a b, Coercible a' b') => (a -> b) -> ((d -> b) -> c -> b') -> (d -> a) -> c -> a'
- CoercibleUtils: op :: Coercible a b => (a -> b) -> b -> a
- CoercibleUtils: over :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a') -> b -> b'
- CoercibleUtils: over2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a -> a') -> b -> b -> b'
- CoercibleUtils: overF :: (Coercible a b, Coercible a' b', Functor f, Functor g) => (a -> b) -> (f a -> g a') -> f b -> g b'
- CoercibleUtils: under :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b') -> a -> a'
- CoercibleUtils: under2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b -> b') -> a -> a -> a'
- CoercibleUtils: underF :: (Coercible a b, Coercible a' b', Functor f, Functor g) => (a -> b) -> (f b -> g b') -> f a -> g a'
+ CoercibleUtils.Compose: (#.) :: Coercible b c => (b `to` c) -> (a -> b) -> a -> c
+ CoercibleUtils.Compose: (.#) :: Coercible a b => (b -> c) -> (a `to` b) -> a -> c
+ CoercibleUtils.Compose: infixr 9 .#
+ CoercibleUtils.Newtype: ala :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((o -> n) -> b -> n') -> b -> o'
+ CoercibleUtils.Newtype: ala' :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
+ CoercibleUtils.Newtype: class Newtype n o => HasUnderlying o n
+ CoercibleUtils.Newtype: class Newtype n (O n) => IsNewtype n
+ CoercibleUtils.Newtype: class Coercible n o => Newtype (n :: k) (o :: k)
+ CoercibleUtils.Newtype: class Similar (n :: k) (n' :: k)
+ CoercibleUtils.Newtype: instance (GHC.Generics.Generic n, CoercibleUtils.Newtype.NewtypeF n o, GHC.Types.Coercible n o) => CoercibleUtils.Newtype.Newtype n o
+ CoercibleUtils.Newtype: instance CoercibleUtils.Newtype.Newtype n (CoercibleUtils.Newtype.O n) => CoercibleUtils.Newtype.IsNewtype n
+ CoercibleUtils.Newtype: instance forall k (n :: k) (n' :: k). (CoercibleUtils.Newtype.Similar' n n', CoercibleUtils.Newtype.Similar' n' n) => CoercibleUtils.Newtype.Similar n n'
+ CoercibleUtils.Newtype: instance forall k (n :: k) (o :: k). CoercibleUtils.Newtype.Newtype n o => CoercibleUtils.Newtype.HasUnderlying o n
+ CoercibleUtils.Newtype: op :: Coercible a b => (a `to` b) -> b -> a
+ CoercibleUtils.Newtype: over :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o') -> n -> n'
+ CoercibleUtils.Newtype: over2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (o -> o -> o') -> n -> n -> n'
+ CoercibleUtils.Newtype: overF :: (Newtype n o, Coercible (f n) (f o), Coercible (g o') (g n'), Newtype n' o', Similar n n') => (o `to` n) -> (f o -> g o') -> f n -> g n'
+ CoercibleUtils.Newtype: pack :: Newtype n o => o -> n
+ CoercibleUtils.Newtype: type O x = GO (Rep x)
+ CoercibleUtils.Newtype: under :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n') -> o -> o'
+ CoercibleUtils.Newtype: under2 :: (Newtype n o, Newtype n' o', Similar n n') => (o `to` n) -> (n -> n -> n') -> o -> o -> o'
+ CoercibleUtils.Newtype: underF :: (Newtype n o, Coercible (f o) (f n), Coercible (g n') (g o'), Newtype n' o', Similar n n') => (o `to` n) -> (f n -> g n') -> f o -> g o'
+ CoercibleUtils.Newtype: unpack :: Newtype n o => n -> o
- CoercibleUtils: (#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
+ CoercibleUtils: (#.) :: Coercible b c => (b `to` c) -> (a -> b) -> a -> c
- CoercibleUtils: (.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
+ CoercibleUtils: (.#) :: Coercible a b => (b -> c) -> (a `to` b) -> a -> c

Files

CHANGELOG.md view
@@ -1,12 +1,24 @@ # Changelog `coercible-utils` uses [PVP Versioning][PVP]. +## [0.1.0] – 2019-09-07++* Improve type inference via a new generic `Newtype` class. ([#14], [#16])+* Improve type signatures to point out which arguments are used only to+  direct type inference. ([#13])++ ## [0.0.0] – 2018-06-29 Initial release.  -[Unreleased]: https://github.com/sjakobi/coercible-utils/compare/v0.0.0...HEAD+[Unreleased]: https://github.com/sjakobi/coercible-utils/compare/v0.1.0...HEAD+[0.1.0]: https://github.com/sjakobi/coercible-utils/compare/v0.0.0...v0.1.0 [0.0.0]: https://github.com/sjakobi/coercible-utils/releases/tag/v0.0.0++[#13]: https://github.com/sjakobi/coercible-utils/pull/13+[#14]: https://github.com/sjakobi/coercible-utils/pull/14+[#16]: https://github.com/sjakobi/coercible-utils/pull/16  [PVP]: https://pvp.haskell.org 
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
coercible-utils.cabal view
@@ -1,29 +1,30 @@ name:                coercible-utils-version:             0.0.0+version:             0.1.0 description:         Utility functions for Coercible types.-synopsis:            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+author:              Simon Jakobi, chessai, David Feuer 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+tested-with:         GHC == 8.4.4+                   , GHC == 8.6.5+                   , GHC == 8.8.1  library   hs-source-dirs:      src   exposed-modules:     CoercibleUtils+                     , CoercibleUtils.Compose+                     , CoercibleUtils.Newtype                           ghc-options:         -Wall-  build-depends:       base >= 4.8 && < 4.13+  build-depends:       base >= 4.11 && < 4.14                         default-language:    Haskell2010   
src/CoercibleUtils.hs view
@@ -1,194 +1,22 @@-{- |-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+{-# language TypeOperators #-} ->>> under2 Min (<>) 2 (1 :: Int) :: Int-1+{- |+This module reexports the entire content of the `coercible-utils` package. ->>> over All not (All False) :: All-All {getAll = True)+See the 'CoercibleUtils.Newtype' module for the newtype combinators. -__Note__: All of the functions in this module take an argument that solely+__Note__: Most functions in this package take an argument that solely directs the /type/ of the coercion. The value of this argument is /ignored/.+In each case, this argument has a type that looks like @a \`to\` b@. As the name+of the @to@ type variable suggests, this will typically be a function from+@a@ to @b@. But leaving the type variable completely polymorphic and+unconstrained lets the type signature communicate the fact that the argument+is not used. -} module CoercibleUtils-  ( -- * Coercive composition-    (#.), (.#)--    -- * The classic "newtype" combinators-  , op-  , ala, ala'-  , under, over-  , under2, over2-  , underF, overF+  ( module CoercibleUtils.Newtype+  , (#.), (.#)   ) 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 #-}+import CoercibleUtils.Compose ((#.), (.#))+import CoercibleUtils.Newtype
+ src/CoercibleUtils/Compose.hs view
@@ -0,0 +1,51 @@+{-# language TypeOperators #-}++{-|+Coercive function composition.++__Note__: The functions in this module take an argument that solely+directs the /type/ of the coercion. The value of this argument is /ignored/.+In each case, this argument has a type that looks like @a \`to\` b@. As the name+of the @to@ type variable suggests, this will typically be a function from+@a@ to @b@. But leaving the type variable completely polymorphic and+unconstrained lets the type signature communicate the fact that the argument+is not used.+-}+module CoercibleUtils.Compose+  ( (#.)+  , (.#)+  ) 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 `to` 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 `to` b) -> a -> c+(.#) f _ = coerce f+{-# INLINE (.#) #-}
+ src/CoercibleUtils/Newtype.hs view
@@ -0,0 +1,328 @@+{-# language FlexibleContexts           #-}+{-# language FlexibleInstances          #-}+{-# language MultiParamTypeClasses      #-}+{-# language ScopedTypeVariables        #-}+{-# language TypeFamilies               #-}+{-# language TypeOperators              #-}+{-# language DataKinds                  #-}+{-# language UndecidableInstances       #-}+{-# language ConstraintKinds            #-}+{-# language PolyKinds                  #-}++{- |+A version of the 'Newtype' typeclass and related functions.  The API is+primarily pulled from Conor McBride's Epigram work. The general idea is that we+can manipulate types in terms of newtypes around them or newtypes in terms of+their underlying types. Some examples:++>>> ala Sum foldMap [1,2,3,4]+10++>>> ala Endo foldMap [(+1), (+2), (subtract 1), (*2)] 3+8++>>> under2 Min (<>) 2 1+1++>>> over All not (All False)+All {getAll = True)++The version of the 'Newtype' class exported by this module has an instance for+*all* and *only* newtypes with 'Generic' instances whose generated+'Coercible' instances are visible. Users need not, and probably should not, write+their own instances.++Like McBride's version, and unlike the one in @newtype-generics@, this version+has two parameters: one for the newtype and one for the underlying type. This+is mostly a matter of taste.++__Note__: Most functions in this module take an argument representing a newtype+constructor. This is used only for its type. To make that clear, the type of+that argument is allowed to be extremely polymorphic: @o \`to\` n@ rather than+@o -> n@. Unfortunately, GHCi displays this as @to o n@, which is ugly but+equivalent.++General approach: When the type variables @n@ and @o@ appear, @n@ is required+to be a newtype wrapper around @o@. Similarly, when the type variables @n'@ and+@o'@ appear as well, @n'@ is required to be a newtype wrapper around @o'@.+Furthermore, in this case, @n@ and @n'@ are required to be the /same newtype/,+with possibly different type arguments. See 'Similar' for detailed+documentation.++@since TODO+-}+module CoercibleUtils.Newtype+  ( Newtype+  , IsNewtype+  , HasUnderlying+  , O+  , Similar+  , pack+  , unpack+  , op+  , ala+  , ala'+  , under+  , over+  , under2+  , over2+  , underF+  , overF+  ) where++import GHC.Generics+import Data.Coerce+import GHC.TypeLits (TypeError, ErrorMessage (..))+import CoercibleUtils.Compose ((#.), (.#))+import Data.Kind (Constraint)++-- | Get the underlying type of a newtype.+--+-- @+-- data N = N Int deriving Generic+-- -- O N = Int+-- @+type O x = GO (Rep x)++-- | Get the underlying type of a newtype from its generic+-- representation.+type family GO rep where+  GO (D1 _d (C1 _c (S1 _s (K1 _i a)))) = a++-- | Given types @x@ and @o@, produce a constraint requiring that @x@ be a+-- newtype whose underlying type is @o@.+type NewtypeF x o = GNewtypeF x (Rep x) o++-- | Putting a newtype check and 'TypeError' call in 'GO' and then requiring @o+-- ~ O n@ doesn't get us a custom type error when we want one. Calculating the+-- constraint with an error case, however, seems to do the trick.+type family GNewtypeF x rep o :: Constraint where+  GNewtypeF _x (D1 ('MetaData _n _m _p 'True) (C1 _c (S1 _s (K1 _i a)))) o = a ~ o+  GNewtypeF x _rep _o = TypeError+    ('Text "There is no " ':<>: 'ShowType Newtype ':<>: 'Text " instance for"+      ':$$: 'Text "    " ':<>: 'ShowType x+      ':$$: 'Text "because it is not a newtype.")++-- | @Newtype n o@ means that @n@ is a newtype wrapper around @o@. @n@ must be+-- an instance of 'Generic'. Furthermore, the @'Coercible' n o@ instance must+-- be visible; this typically means the newtype constructor is visible, but the+-- instance could also have been brought into view by pattern matching on a+-- 'Data.Type.Coercion.Coercion'.+class Coercible n o => Newtype (n :: k) (o :: k)++-- The Generic n constraint gives a much better type error if n is not an+-- instance of Generic. Without that, there's just a mysterious message+-- involving GO and Rep. With it, the lousy error message still shows up, but+-- at least there's also a good one.+instance (Generic n, NewtypeF n o, Coercible n o) => Newtype n o++-- | A single-parameter version of 'Newtype', similar to the @Newtype@ class in+-- @newtype-generics@.+--+-- @Newtype n o@ is equivalent to @(IsNewtype n, o ~ O n)@.+class Newtype n (O n) => IsNewtype n+instance Newtype n (O n) => IsNewtype n++-- | A version of 'Newtype' with the parameters flipped, for partial+-- application.+class Newtype n o => HasUnderlying o n+instance Newtype n o => HasUnderlying o n++-- | Two types are @Similar@ if they are built from+-- the same type constructor and the same kind arguments.+--+-- @Sum Int@ and @Sum Bool@ are @Similar@.+--+-- @Sum Int@ and @Product Int@ are not @Similar@+-- because they are built from different type constructors.+--+-- @Const Int Char@ and @Const Int Maybe@ are not @Similar@+-- because they have different kind arguments.+class Similar (n :: k) (n' :: k)+-- See [Note: Similar implementation]++instance (Similar' n n', Similar' n' n) => Similar n n'++-- | Given a type of the form (f b), try to extract b, assuming that b is of+-- kind kb. Note that kb itself is an implicit argument to GetArg; the+-- surrounding context of the call must determine kb.+type family GetArg (x :: kx) :: kb where+  GetArg (_ b) = b++-- | Given a type of the form (f b), try to extract f, assuming that f is of+-- kind kf. Note that kf itself is an implicit argument to GetFun; the+-- surrounding context of the call must determine kf.+type family GetFun (x :: kx) :: kf where+  GetFun (f _) = f++-- | Given types @n@ and @n'@, produce a constraint requiring that @n'@ be+-- built from the same newtype constructor as @n@. See [Note: Similar+-- implementation].+type family Similar' (n :: k) (n' :: k) :: Constraint where+  Similar' (f (_a :: ka)) n' =+    ( Similar' f (GetFun n')+    , n' ~ GetFun n' (GetArg n' :: ka))+  Similar' f g = f ~ g+-- We capture the kind of the argument as ka, and pass it to GetArg.+-- The kind of the first call to GetFun is fixed by the kind of f,+-- while the kind of the second is fixed by the kind of n' and the+-- imposed kind, ka, of GetArg.++{-+[Note: Similar implementation]++The Similar class is what really separates this implementation of this API from+all previous ones of which I am aware. Since it's not the simplest thing, I'll+give an extended description of the implementation here.++We really want n to give us information about n'. It's also nice (for typed+holes and error messages, particularly) if n' gives us information about n.+Since we may know nothing, a priori, about one of those, we have to be a bit+careful not to force a match on one when the other is the one with information.+The horrible way to do that (even worse :t results!) is with INCOHERENT+typeclass instances. Ignoring that awfulness, the thing to do is to require n'+to have a structure calculated from n and the other way around, "in parallel".+Similar' n n' matches on n, producing a constraint. Suppose we have n ~ F a b.+Then we get++   Similar' (F a b) n'+   (Similar' (F a) (GetFun n'), n' ~ GetFun n' (GetArg n'))++We have now constrained things only a little: n' is required to have the form p+q for some p and q, where F a and p have the same kind and b and q have the+same kind. Substituting in p and q, we continue:++   (Similar' (F a) p, n' ~ p q)+   ((Similar' F (GetFun p), p ~ GetFun p (GetArg p)), n' ~ p q)++Let's set r ~ GetFun p and s ~ GetArg p. Then++   ((Similar' F r, p ~ r s), n' ~ p q)++We've now reached the base case! Yay! So the last step is++   ((F ~ r, p ~ r s), n' ~ p q)++which then simplifies to++   n' ~ F s q++Undoing the substitutions we made,++   n' ~ F (GetArg (GetFun n')) (GetArg n')++The arguments in that constraint are completely useless (as far as I know), but+we need to put it all together like that to get what we're after: an equality+constraint on n' itself that lets GHC know it's F x y for some x and y to be+determined. Very often, those are then fixed by the type o' and the Newtype n'+o' constraint, which at first seems backwards. Say we consider Sum. We have++   type Rep (Sum a) = M1 _ _ (M1 _ _ (M1 _ _ (K1 _ a)))++This can reduce as soon as GHC sees we have Sum whatever! So then the+NewtypeF-calculated constraint can constrain the type argument to whatever's+required to wrap the new contents. Magic!+-}++-- | Wrap a value with a newtype constructor.+pack :: Newtype n o => o -> n+pack = coerce++-- | Unwrap a newtype constructor from a value.+unpack :: Newtype n o => n -> o+unpack = coerce++-- | Reverse the type of a "packer".+--+-- >>> op All (All True)+-- True+-- >>> op (Identity . Sum) (Identity (Sum 3))+-- 3+op :: Coercible a b+   => (a `to` 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 :: (Newtype n o, Newtype n' o')+-- >        => (o -> n) -> (n -> n -> n') -> (o -> o -> o')+-- > under2' pa f o0 o1 = ala pa (\p -> uncurry f . bimap p p) (o0, o1)+--+-- 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]+-- 10+ala :: (Newtype n o, Newtype n' o', Similar n n')+    => (o `to` n) -> ((o -> n) -> b -> n') -> (b -> o')+ala pa hof = ala' pa hof id++-- | This is the original function seen in Conor McBride's work.+-- 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"]+-- 10+--+-- >>> ala' First foldMap (readMaybe @Int) ["x", "42", "1"]+-- Just 42+ala' :: (Newtype n o, Newtype n' o', Similar n n')+     => (o `to` n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o')+--ala' _ hof f = unpack . hof (coerce . f)+ala' _ = coerce++-- | A very simple operation involving running the function \'under\' the newtype.+--+-- >>> under Product (stimes 3) 3+-- 27+under :: (Newtype n o, Newtype n' o', Similar n n')+      => (o `to` n) -> (n -> n') -> (o -> o')+under _ f = unpack #. f .# coerce++-- | The opposite of 'under'. I.e., take a function which works on the+-- underlying types, and switch it to a function that works on the newtypes.+--+-- >>> over All not (All False)+-- All {getAll = True}+over :: (Newtype n o,  Newtype n' o', Similar n n')+     => (o `to` n) -> (o -> o') -> (n -> n')+over _ f = pack #. f .# coerce++-- | Lower a binary function to operate on the underlying values.+--+-- >>> under2 Any (<>) True False+-- True+under2 :: (Newtype n o, Newtype n' o', Similar n n')+       => (o `to` n) -> (n -> n -> n') -> (o -> o -> o')+--under2 _ f o0 o1 = unpack $ f (coerce o0) (coerce o1)+under2 _ = coerce++-- | The opposite of 'under2'.+over2 :: (Newtype n o, Newtype n' o', Similar n n')+       => (o `to` n) -> (o -> o -> o') -> (n -> n -> n')+--over2 _ f n0 n1 = pack $ f (coerce n0) (coerce n1)+over2 _ = coerce++-- | 'under' lifted into a functor.+underF :: ( Newtype n o, Coercible (f o) (f n)+          , Coercible (g n') (g o'), Newtype n' o', Similar n n')+       => (o `to` n) -> (f n -> g n') -> (f o -> g o')+underF _ f = coerce #. f .# coerce++-- | 'over' lifted into a functor.+overF :: ( Newtype n o, Coercible (f n) (f o), Coercible (g o') (g n')+         , Newtype n' o', Similar n n')+      => (o `to` n) -> (f o -> g o') -> (f n -> g n')+overF _ f = coerce #. f .# coerce
test/Spec.hs view
@@ -1,3 +1,104 @@+{-# language PartialTypeSignatures #-}+-- We definitely don't want to infer the types of the test functions+-- based on how they're *used*; if their implementations and (partial)+-- signatures aren't sufficient, then we don't want them to have+-- Typeable instances.+{-# language NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}++module Main (main) where+import Data.Monoid (Sum (..), All (..))+import CoercibleUtils.Newtype+import Type.Reflection++-- We don't want defaults making it look like things are working+-- if they're not!+default ()++pack_test0 :: _ -> All+pack_test0 = pack++pack_test1a :: _ -> Sum Int+pack_test1a = pack++pack_test1b :: Int -> Sum _+pack_test1b = pack++unpack_test0 :: All -> _+unpack_test0 = unpack++unpack_test1a :: Sum Int -> _+unpack_test1a = unpack++unpack_test1b :: Sum _ -> Int+unpack_test1b = unpack++-- Fix n+ala_test0a+ :: (_ -> All) -> (_ -> Bool -> _) -> Bool -> _+ala_test0a = ala++-- Fix n'+ala_test0b+ :: (_ -> _) -> (_ -> Bool -> All) -> (Bool -> _)+ala_test0b = ala++-- Fix o and o', partially fix n+ala_test1a :: (Integer -> Sum _) -> (_ -> [Integer] -> _) -> [Integer] -> Word+ala_test1a = ala+    --  => (o `to` n) -> ((o -> n) -> b -> n') -> (b -> o')++-- Fix o', partially fix n, and partially fix n'+ala_test1b :: (_ -> Sum _) -> ((_ -> _ Integer) -> [Integer] -> _) -> [Integer] -> Word+ala_test1b = ala++-- Fix o and n'; infer o' and n+ala_test1c :: (Integer -> _) -> ((_ -> _) -> [Integer] -> Sum Word) -> [Integer] -> _+ala_test1c = ala++-- Fix o' and n; infer o and n'+ala_test1d :: (_ -> Sum Integer) -> (_ -> [Integer] -> _) -> [Integer] -> Word+ala_test1d = ala++under_test0a :: (_ -> All) -> _ -> _ -> _+under_test0a = under++under_test0b :: (_ -> _) -> (_ -> All) -> _ -> _+under_test0b = under++over_test0a :: (_ -> All) -> _ -> _ -> _+over_test0a = over++over_test0b :: (_ -> _) -> _ -> _ -> All+over_test0b = over+ main :: IO ()-main = putStrLn ("Test suite not yet implemented" :: String)+main = do+  print $ (pack True :: All)+  print $ unpack (All True)+  print $ ala Sum foldMap [1..10 :: Int]+  print $ under Sum (fmap (+1)) (3 :: Int)+  print $ over Sum (+3) (Sum (3 :: Int)) +  -- Make sure the types are monomorphic. This is guaranteed by the+  -- fact that the Typeable instances are resolved. Also make sure these+  -- functions have the expected types!+  print $ typeOf pack_test0+  print $ typeOf pack_test1a+  print $ typeOf pack_test1b+  print $ typeOf unpack_test0+  print $ typeOf unpack_test1a+  print $ typeOf unpack_test1b++  print $ typeOf ala_test0a+  print $ typeOf ala_test0b+  print $ typeOf ala_test1a+  print $ typeOf ala_test1b+  print $ typeOf ala_test1c+  print $ typeOf ala_test1d++  print $ typeOf under_test0a+  print $ typeOf under_test0b++  print $ typeOf over_test0a+  print $ typeOf over_test0b