generic-functor (empty) → 0.0.1.0

raw patch · 7 files changed

+418/−0 lines, 7 filesdep +basedep +generic-functorsetup-changed

Dependencies added: base, generic-functor

Files

CHANGELOG.md +3/−0
LICENSE +19/−0
Setup.hs +2/−0
generic-functor.cabal +40/−0
src/Generic/Functor.hs +16/−0
src/Generic/Functor/Internal.hs +230/−0
test/test.hs +108/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+## 0.0.1.0++* Create generic-functor

+ LICENSE view

@@ -0,0 +1,19 @@+Copyright Li-yao Xia (c) 2020++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the “Software”), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ generic-functor.cabal view

@@ -0,0 +1,40 @@+cabal-version:       >=1.10+name:                generic-functor+version:             0.0.1.0+synopsis: Deriving generalized functors with GHC.Generics+description:+  Derive @fmap@, and other @fmap@-like functions where the+  parameter of the functor could occur anywhere.+  .+  See the README for details.+homepage:            https://gitlab.com/lysxia/generic-functor+bug-reports:         https://gitlab.com/lysxia/generic-functor/-/issues+license:             MIT+license-file:        LICENSE+author:              Li-yao Xia+maintainer:          lysxia@gmail.com+copyright:           Li-yao Xia 2020+category:            Generics+build-type:          Simple+extra-source-files:  CHANGELOG.md++library+  hs-source-dirs: src+  exposed-modules:+    Generic.Functor+    Generic.Functor.Internal+  build-depends:       base >=4.12 && <4.15+  default-language:    Haskell2010++test-suite examples+  hs-source-dirs: test+  main-is: test.hs+  build-depends:+    generic-functor,+    base+  type: exitcode-stdio-1.0+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://gitlab.com/lysxia/generic-functor

+ src/Generic/Functor.hs view

@@ -0,0 +1,16 @@+-- | Generic and generalized functors.++module Generic.Functor+  ( -- * Derive functors+    gsolomap+  , solomap+  , DeriveFunctor(..)+  , gfmap++    -- * Auxiliary classes+  , GFunctor()+  , GSolomap()+  , Solomap()+  ) where++import Generic.Functor.Internal

+ src/Generic/Functor/Internal.hs view

@@ -0,0 +1,230 @@+{-# LANGUAGE+  EmptyCase,+  FlexibleContexts,+  FlexibleInstances,+  MultiParamTypeClasses,+  QuantifiedConstraints,+  ScopedTypeVariables,+  TypeApplications,+  TypeOperators,+  UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++-- | This is an internal module. Look, don't touch.+--+-- "Generic.Functor" is the public API.++module Generic.Functor.Internal where++import Data.Bifunctor+import Data.Coerce+import GHC.Generics++-- | Generic implementation of 'fmap'. See also 'DeriveFunctor' for deriving-via,+-- using 'gfmap' under the hood.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gfmap')+--+-- data Twice a = Twice (Either a a)+--   deriving 'Generic'+--+-- instance 'Functor' Twice where+--   'fmap' = 'gfmap'+-- @+--+-- Unlike 'gsolomap', 'gfmap' is safe to use in all contexts.+gfmap :: forall f a b. GFunctor f => (a -> b) -> (f a -> f b)+gfmap f = to . gmap1 f . from :: GFunctorRep a b f => f a -> f b++-- | Generalized generic functor.+--+-- 'gsolomap' is a generalization of 'gfmap' (generic 'fmap'),+-- where the type parameter to be \"mapped\" does not have to be the last one.+--+-- 'gsolomap' is __unsafe__: misuse will break your programs.+-- Read the Usage section below for details.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gsolomap')+--+-- data Result a r = Error a | Ok r  -- Another name for Either+--   deriving 'Generic'+--+-- mapError :: (a -> b) -> Result a r -> Result b r+-- mapError = 'gsolomap'+--+-- mapOk :: (r -> s) -> Result a r -> Result a s+-- mapOk = 'gsolomap'+--+-- mapBoth :: (a -> b) -> Result a a -> Result b b+-- mapBoth = 'gsolomap'+-- @+--+-- === Usage #gsolomapusage#+--+-- (This also applies to 'solomap'.)+--+-- 'gsolomap' should only be used to define __polymorphic__ "@fmap@-like functions".+-- It works only in contexts where @a@ and @b@ are two distinct, non-unifiable+-- type variables. This is usually the case when they are bound by universal+-- quantification (@forall a b. ...@), with no equality constraints on @a@ and+-- @b@.+--+-- The one guarantee of 'gsolomap' is that @'gsolomap' 'id' = 'id'@.+-- Under the above conditions, that law and the types should uniquely determine+-- the implementation, which 'gsolomap' seeks automatically.+--+-- The unsafety is due to the use of incoherent instances as part of the+-- definition of 'GSolomap'. Functions are safe to specialize after 'GSolomap'+-- (and 'Solomap') constraints have been discharged.+gsolomap :: forall a b x y. (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)+gsolomap f = to . gmap1 f . from++-- | Generalized implicit functor.+--+-- Use this when @x@ and @y@ are applications of existing functors+-- ('Functor', 'Bifunctor').+--+-- This is a different use case from 'gfmap' and 'gsolomap', which make+-- functors out of freshly declared @data@ types.+--+-- 'solomap' is __unsafe__: misuse will break your programs.+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- map1 :: (a -> b) -> Either e (Maybe [IO a]) -> Either e (Maybe [IO b])+-- map1 = 'solomap'+-- -- equivalent to:   fmap . fmap . fmap . fmap+--+-- map2 :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)+-- map2 = 'solomap'+-- -- equivalent to:   \\f -> fmap (bimap (fmap f) id)+-- @+solomap :: forall a b x y. Solomap a b x y => (a -> b) -> (x -> y)+solomap = solomap_++-- ** Constraints for @gfmap@++-- | Constraint for 'gfmap'.+class    (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f+instance (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f++-- | Internal component of 'GFunctor'.+--+-- This is an example of the \"quantified constraints trick\" to encode+-- @forall a b. GMap1 a b (Rep (f a)) (Rep (f b))@ which doesn't actually+-- work as-is.+class    GMap1 a b (Rep (f a)) (Rep (f b)) => GFunctorRep a b f+instance GMap1 a b (Rep (f a)) (Rep (f b)) => GFunctorRep a b f++-- ** Constraint for @gsolomap@++-- | Constraint for 'gsolomap'.+class    GMap1 a b (Rep x) (Rep y) => GSolomap a b x y+instance GMap1 a b (Rep x) (Rep y) => GSolomap a b x y++-- ** Constraint for @solomap@++-- | Constraint for 'solomap'.+class    Solomap_ a b x y => Solomap a b x y+instance Solomap_ a b x y => Solomap a b x y++-- * Deriving Via++-- | @newtype@ for @DerivingVia@ of 'Functor' instances.+--+-- Note: the GHC extension @DeriveFunctor@ already works out-of-the-box in most+-- cases. There are exceptions, such as the following example:+--+-- @+-- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('DeriveFunctor'(..))+--+-- data Twice a = Twice (Either a a)+--   deriving 'Generic'+--   deriving 'Functor' via ('DeriveFunctor' Twice)+-- @+newtype DeriveFunctor f a = DeriveFunctor (f a)++instance GFunctor f => Functor (DeriveFunctor f) where+  fmap = coerce' (gfmap @f) where+    coerce' :: Coercible s t => (r -> s) -> (r -> t)+    coerce' = coerce++--++class GMap1 a b f g where+  gmap1 :: (a -> b) -> f () -> g ()++instance GMap1 a b f g => GMap1 a b (M1 i c f) (M1 i' c'' g) where+  gmap1 = coerce (gmap1 @a @b @f @g)++instance (GMap1 a b f1 g1, GMap1 a b f2 g2) => GMap1 a b (f1 :+: f2) (g1 :+: g2) where+  gmap1 f (L1 x) = L1 (gmap1 f x)+  gmap1 f (R1 x) = R1 (gmap1 f x)++instance (GMap1 a b f1 g1, GMap1 a b f2 g2) => GMap1 a b (f1 :*: f2) (g1 :*: g2) where+  gmap1 f (x :*: y) = gmap1 f x :*: gmap1 f y++instance GMap1 a b U1 U1 where+  gmap1 _ U1 = U1++instance GMap1 a b V1 V1 where+  gmap1 _ v = case v of {}++instance Solomap_ a b x y => GMap1 a b (K1 i x) (K1 i' y) where+  gmap1 = coerce (solomap_ @a @b @x @y)++-- | Internal implementation of 'Solomap'.+class Solomap_ a b x y where+  solomap_ :: (a -> b) -> x -> y++instance {-# INCOHERENT #-} Solomap_ a b a b where+  solomap_ = id++-- "id" instance+instance {-# INCOHERENT #-} Solomap_ a b x x where+  solomap_ _ = id++-- "Functor" instance+instance {-# INCOHERENT #-} (Functor f, Solomap_ a b x y) => Solomap_ a b (f x) (f y) where+  solomap_ = fmap . solomap_++-- Intersection of "id" and "Functor" instances. Prefer "id".+-- When both of those instances match then this one should match and avoid an+-- unnecessary and overly restrictive Functor constraint.+instance {-# INCOHERENT #-} Solomap_ a b (f x) (f x) where+  solomap_ _ = id++instance (Solomap_ a b y1 x1, Solomap_ a b x2 y2) => Solomap_ a b (x1 -> x2) (y1 -> y2) where+  solomap_ f u = solomap_ f . u . solomap_ f++-- "Bifunctor" instance.+instance {-# INCOHERENT #-} (Bifunctor f, Solomap_ a b x1 y1, Solomap_ a b x2 y2)+  => Solomap_ a b (f x1 x2) (f y1 y2) where+  solomap_ f = bimap (solomap_ f) (solomap_ f)++-- Intersection of "Bifunctor" and "Functor" instances. Prefer "Functor".+instance {-# INCOHERENT #-} (Functor (f x), Solomap_ a b x2 y2)+  => Solomap_ a b (f x x2) (f x y2) where+  solomap_ = fmap . solomap_++-- Intersection of "Bifunctor", "Functor", and "id" instances. Prefer "id".+instance {-# INCOHERENT #-} Solomap_ a b (f x y) (f x y) where+  solomap_ _ = id

+ test/test.hs view

@@ -0,0 +1,108 @@+{-# LANGUAGE+  DeriveGeneric,+  DerivingVia #-}++import Data.Bifunctor+import GHC.Generics+import Generic.Functor+import System.Exit (exitFailure)++-- Testing DeriveFunctor (gfmap) and gsolomap++data Empty a+  deriving Generic+  deriving Functor via (DeriveFunctor Empty)++data Unit a = Unit+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor Unit)++data Result a r = Error a | Ok r+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor (Result a))+  +mapError :: (a -> b) -> Result a r -> Result b r+mapError = gsolomap++mapOk :: (r -> s) -> Result a r -> Result a s+mapOk = gsolomap++mapBoth :: (a -> b) -> Result a a -> Result b b+mapBoth = gsolomap++data Writer w a = Writer w a+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor (Writer w))++mapW :: (w -> w') -> Writer w a -> Writer w' a+mapW = gsolomap++data Square a b = Square a a b b+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor (Square a))++mapFirst :: (a -> a') -> Square a b -> Square a' b+mapFirst = gsolomap++data Twice a = Twice (Either a a)+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor Twice)++-- Testing solomap++map1, map1' :: (a -> b) -> Either e (Maybe [(e, a)]) -> Either e (Maybe [(e, b)])+map1 = solomap+map1' = fmap . fmap . fmap . fmap  -- equivalent definition, just making sure it typechecks++map2, map2' :: (a -> b) -> (e -> Either [a] r) -> (e -> Either [b] r)+map2 = solomap+map2' f = fmap (bimap (fmap f) id)++type F a = ([a], Either a ())++map3, map3' :: (a -> b) -> F a -> F b+map3 = solomap+map3' f = bimap (fmap f) (bimap f id)++type G t a = (t, Maybe [Either Bool a])++map4 :: (a -> b) -> G t a -> G t b+map4 = solomap+map4' = fmap . fmap . fmap . fmap++-- Run at least once++twice :: Int -> Int+twice = (* 2)++main :: IO ()+main = do+  Unit @= fmap twice Unit+  Ok 8 @= fmap twice (Ok 4 :: Result () Int)+  Error 8 @= mapError twice (Error 4 :: Result Int ())+  Writer () 8 @= fmap twice (Writer () 4)+  Writer 8 () @= mapW twice (Writer 4 ())+  Square () () 8 10 @= fmap twice (Square () () 4 5)+  Square 8 10 () () @= mapFirst twice (Square 4 5 () ())+  [Twice (Left 8), Twice (Right 10)] @= (fmap . fmap) twice [Twice (Left 4), Twice (Right 5)]++  let t1 = Right (Just [((), 4)])+  map1 twice t1 @= map1' twice t1++  let t2 x = Left [x] :: Either [Int] ()+  map2 twice t2 4 @= map2' twice t2 4++  let t3 = ([4], Left 5)+  map3 twice t3 @= map3' twice t3++  let t4 = ((), Just [Right 4])+  map4 twice t4 @= map4' twice t4++-- Assert equality+(@=) :: (Eq a, Show a) => a -> a -> IO ()+(@=) x y | x == y = pure ()+         | otherwise = do+  putStrLn "Not equal:"+  print x+  print y+  exitFailure