packages feed

hkd (empty) → 0.1

raw patch · 8 files changed

+1386/−0 lines, 8 filesdep +basedep +hkddep +semigroups

Dependencies added: base, hkd, semigroups, some, tagged, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0++* Split off from `codex`
+ LICENSE.md view
@@ -0,0 +1,230 @@+# License++Licensed under either of+ * Apache License, Version 2.0 (http://www.apache.org/licenses/LICENSE-2.0)+ * BSD 2-Clause license (https://opensource.org/licenses/BSD-2-Clause)+at your option.++## BSD 2-Clause License++- Copyright 2019 Edward Kmett and Sean Chalmers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.++## Apache License++_Version 2.0, January 2004_  +_&lt;<http://www.apache.org/licenses/>&gt;_++### Terms and Conditions for use, reproduction, and distribution++#### 1. Definitions++“License” shall mean the terms and conditions for use, reproduction, and+distribution as defined by Sections 1 through 9 of this document.++“Licensor” shall mean the copyright owner or entity authorized by the copyright+owner that is granting the License.++“Legal Entity” shall mean the union of the acting entity and all other entities+that control, are controlled by, or are under common control with that entity.+For the purposes of this definition, “control” means **(i)** the power, direct or+indirect, to cause the direction or management of such entity, whether by+contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the+outstanding shares, or **(iii)** beneficial ownership of such entity.++“You” (or “Your”) shall mean an individual or Legal Entity exercising+permissions granted by this License.++“Source” form shall mean the preferred form for making modifications, including+but not limited to software source code, documentation source, and configuration+files.++“Object” form shall mean any form resulting from mechanical transformation or+translation of a Source form, including but not limited to compiled object code,+generated documentation, and conversions to other media types.++“Work” shall mean the work of authorship, whether in Source or Object form, made+available under the License, as indicated by a copyright notice that is included+in or attached to the work (an example is provided in the Appendix below).++“Derivative Works” shall mean any work, whether in Source or Object form, that+is based on (or derived from) the Work and for which the editorial revisions,+annotations, elaborations, or other modifications represent, as a whole, an+original work of authorship. For the purposes of this License, Derivative Works+shall not include works that remain separable from, or merely link (or bind by+name) to the interfaces of, the Work and Derivative Works thereof.++“Contribution” shall mean any work of authorship, including the original version+of the Work and any modifications or additions to that Work or Derivative Works+thereof, that is intentionally submitted to Licensor for inclusion in the Work+by the copyright owner or by an individual or Legal Entity authorized to submit+on behalf of the copyright owner. For the purposes of this definition,+“submitted” means any form of electronic, verbal, or written communication sent+to the Licensor or its representatives, including but not limited to+communication on electronic mailing lists, source code control systems, and+issue tracking systems that are managed by, or on behalf of, the Licensor for+the purpose of discussing and improving the Work, but excluding communication+that is conspicuously marked or otherwise designated in writing by the copyright+owner as “Not a Contribution.”++“Contributor” shall mean Licensor and any individual or Legal Entity on behalf+of whom a Contribution has been received by Licensor and subsequently+incorporated within the Work.++#### 2. Grant of Copyright License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable copyright license to reproduce, prepare Derivative Works of,+publicly display, publicly perform, sublicense, and distribute the Work and such+Derivative Works in Source or Object form.++#### 3. Grant of Patent License++Subject to the terms and conditions of this License, each Contributor hereby+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,+irrevocable (except as stated in this section) patent license to make, have+made, use, offer to sell, sell, import, and otherwise transfer the Work, where+such license applies only to those patent claims licensable by such Contributor+that are necessarily infringed by their Contribution(s) alone or by combination+of their Contribution(s) with the Work to which such Contribution(s) was+submitted. If You institute patent litigation against any entity (including a+cross-claim or counterclaim in a lawsuit) alleging that the Work or a+Contribution incorporated within the Work constitutes direct or contributory+patent infringement, then any patent licenses granted to You under this License+for that Work shall terminate as of the date such litigation is filed.++#### 4. Redistribution++You may reproduce and distribute copies of the Work or Derivative Works thereof+in any medium, with or without modifications, and in Source or Object form,+provided that You meet the following conditions:++* **(a)** You must give any other recipients of the Work or Derivative Works a copy of+this License; and+* **(b)** You must cause any modified files to carry prominent notices stating that You+changed the files; and+* **(c)** You must retain, in the Source form of any Derivative Works that You distribute,+all copyright, patent, trademark, and attribution notices from the Source form+of the Work, excluding those notices that do not pertain to any part of the+Derivative Works; and+* **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any+Derivative Works that You distribute must include a readable copy of the+attribution notices contained within such NOTICE file, excluding those notices+that do not pertain to any part of the Derivative Works, in at least one of the+following places: within a NOTICE text file distributed as part of the+Derivative Works; within the Source form or documentation, if provided along+with the Derivative Works; or, within a display generated by the Derivative+Works, if and wherever such third-party notices normally appear. The contents of+the NOTICE file are for informational purposes only and do not modify the+License. You may add Your own attribution notices within Derivative Works that+You distribute, alongside or as an addendum to the NOTICE text from the Work,+provided that such additional attribution notices cannot be construed as+modifying the License.++You may add Your own copyright statement to Your modifications and may provide+additional or different license terms and conditions for use, reproduction, or+distribution of Your modifications, or for any such Derivative Works as a whole,+provided Your use, reproduction, and distribution of the Work otherwise complies+with the conditions stated in this License.++#### 5. Submission of Contributions++Unless You explicitly state otherwise, any Contribution intentionally submitted+for inclusion in the Work by You to the Licensor shall be under the terms and+conditions of this License, without any additional terms or conditions.+Notwithstanding the above, nothing herein shall supersede or modify the terms of+any separate license agreement you may have executed with Licensor regarding+such Contributions.++#### 6. Trademarks++This License does not grant permission to use the trade names, trademarks,+service marks, or product names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the NOTICE file.++#### 7. Disclaimer of Warranty++Unless required by applicable law or agreed to in writing, Licensor provides the+Work (and each Contributor provides its Contributions) on an “AS IS” BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied,+including, without limitation, any warranties or conditions of TITLE,+NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are+solely responsible for determining the appropriateness of using or+redistributing the Work and assume any risks associated with Your exercise of+permissions under this License.++#### 8. Limitation of Liability++In no event and under no legal theory, whether in tort (including negligence),+contract, or otherwise, unless required by applicable law (such as deliberate+and grossly negligent acts) or agreed to in writing, shall any Contributor be+liable to You for damages, including any direct, indirect, special, incidental,+or consequential damages of any character arising as a result of this License or+out of the use or inability to use the Work (including but not limited to+damages for loss of goodwill, work stoppage, computer failure or malfunction, or+any and all other commercial damages or losses), even if such Contributor has+been advised of the possibility of such damages.++#### 9. Accepting Warranty or Additional Liability++While redistributing the Work or Derivative Works thereof, You may choose to+offer, and charge a fee for, acceptance of support, warranty, indemnity, or+other liability obligations and/or rights consistent with this License. However,+in accepting such obligations, You may act only on Your own behalf and on Your+sole responsibility, not on behalf of any other Contributor, and only if You+agree to indemnify, defend, and hold each Contributor harmless for any liability+incurred by, or claims asserted against, such Contributor by reason of your+accepting any such warranty or additional liability.++_END OF TERMS AND CONDITIONS_++### APPENDIX: How to apply the Apache License to your work++To apply the Apache License to your work, attach the following boilerplate+notice, with the fields enclosed by brackets `[]` replaced with your own+identifying information. (Don't include the brackets!) The text should be+enclosed in the appropriate comment syntax for the file format. We also+recommend that a file or class name and description of purpose be included on+the same “printed page” as the copyright notice for easier identification within+third-party archives.++    Copyright [yyyy] [name of copyright owner]+    +    Licensed under the Apache License, Version 2.0 (the "License");+    you may not use this file except in compliance with the License.+    You may obtain a copy of the License at+    +      http://www.apache.org/licenses/LICENSE-2.0+    +    Unless required by applicable law or agreed to in writing, software+    distributed under the License is distributed on an "AS IS" BASIS,+    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+    See the License for the specific language governing permissions and+    limitations under the License.+
+ README.md view
@@ -0,0 +1,16 @@+hkd+===++[![Hackage](https://img.shields.io/hackage/v/hkd.svg)](https://hackage.haskell.org/package/hkd)++This package provides some types and utilities for working with the "higher-kinded data" pattern in Haskell.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett+
+ example/NP.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+#if __GLASGOW_HASKELL__ <800+{-# LANGUAGE UndecidableInstances #-}+#endif+module Main where++#if MIN_VERSION_base(4,9,0)+import Data.Kind (Type)+#else+#define Type *+#endif++import Data.HKD+import Control.Applicative as A (Applicative (pure), liftA2)+import Data.Monoid as Mon (Monoid (..))++-- We can define flipped NP (as in sop-code), which would be instance+-- of classes in Data.HKD++data NP (xs :: [k]) (f :: k -> Type) where+    Nil  :: NP '[] f+    (:*) :: f x -> NP xs f -> NP (x ': xs) f++instance FFunctor (NP xs) where+    ffmap _ Nil       = Nil+    ffmap f (x :* xs) = f x :* ffmap f xs++instance FFoldable (NP xs) where+    ffoldMap _ Nil       = Mon.mempty+    ffoldMap f (x :* xs) = mappend (f x) (ffoldMap f xs)++    flengthAcc !acc Nil       = acc+    flengthAcc !acc (_ :* xs) = flengthAcc acc xs++instance FTraversable (NP xs) where+    ftraverse _ Nil       = A.pure Nil+    ftraverse f (x :* xs) = liftA2 (:*) (f x) (ftraverse f xs)++-------------------------------------------------------------------------------+-- Apply+-------------------------------------------------------------------------------++class FFunctor t => FApply t where+    fliftA2 :: (forall x. f x -> g x -> h x) -> t f -> t g -> t h++instance FApply (NP xs)  where+    fliftA2 _ Nil       Nil       = Nil+    fliftA2 f (x :* xs) (y :* ys) = f x y :* fliftA2 f xs ys++instance FApply (Element a) where+    fliftA2 f (Element x) (Element y) = Element (f x y)++instance FApply (NT f) where+    fliftA2 f (NT g) (NT h) = NT $ \x -> f (g x) (h x)++instance FApply Limit where+    fliftA2 f (Limit x) (Limit y) = Limit (f x y)++-------------------------------------------------------------------------------+-- Applicative+-------------------------------------------------------------------------------++class FApply t => FApplicative t where+    fpure :: (forall x. f x) -> t f++instance FApplicativeNP xs => FApplicative (NP xs) where+    fpure = fpureNP++class FApplicativeNP xs where+    fpureNP :: (forall x. f x) -> NP xs f++instance FApplicativeNP '[] where+    fpureNP _ = Nil++instance FApplicativeNP xs => FApplicativeNP (x ': xs) where+    fpureNP x = x :* fpureNP x++instance FApplicative (Element a) where+    fpure x = Element x++instance FApplicative (NT f) where+    fpure x = NT $ \_ -> x++instance FApplicative Limit where+    fpure x = Limit x++-------------------------------------------------------------------------------+-- Dicts, or what should be a better name?+-------------------------------------------------------------------------------++-- | Dfferent dictionary, not the same as in @constraints@+data Dict c a where+    Dict :: c a => Dict c a++-- | TODO: what should be the superclass?+class FFunctor t => Dicts c t where+    dicts :: t (Dict c)++instance DictsNP c xs => Dicts c (NP xs) where+    dicts = dictsNP++class DictsNP c xs where+    dictsNP :: NP xs (Dict c)++instance DictsNP c '[] where+    dictsNP = Nil++instance (c x, DictsNP c xs) => DictsNP c (x ': xs) where+    dictsNP = Dict :* dictsNP++instance c x => Dicts c (Element x) where+    dicts = Element Dict++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = return ()
+ example/Record.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+module Main (+  main,+  Record (..),+  Cons (..),+  MyU1 (..),+  MyV1,+  ) where++#if MIN_VERSION_base(4,9,0)+import Data.Kind (Type)+#else+#define Type *+#endif++import GHC.Generics (Generic)+import Data.HKD+import Data.Some (Some, mkSome)++data Record f = Record+    { fieldInt    :: f Int+    , fieldString :: f String+    , fieldSome   :: Element Int f+    }+  deriving (Generic)++instance FFunctor     Record where ffmap     = ffmapDefault+instance FFoldable    Record where ffoldMap  = ffoldMapDefault+instance FTraversable Record where ftraverse = gftraverse++instance FZip         Record where fzipWith  = gfzipWith+instance FRepeat      Record where frepeat   = gfrepeat++-------------------------------------------------------------------------------+-- Sum+-------------------------------------------------------------------------------++data Cons f = ConInt (f Int) | ConString (f String)+  deriving (Generic)++instance FFunctor     Cons where ffmap     = ffmapDefault+instance FFoldable    Cons where ffoldMap  = ffoldMapDefault+instance FTraversable Cons where ftraverse = gftraverse++-------------------------------------------------------------------------------+-- Units+-------------------------------------------------------------------------------++data MyU1 (f :: Type -> Type) = MyU1 deriving Generic+data MyV1 (f :: Type -> Type)        deriving Generic++instance FFunctor     MyU1 where ffmap     = ffmapDefault+instance FFoldable    MyU1 where ffoldMap  = ffoldMapDefault+instance FTraversable MyU1 where ftraverse = gftraverse++instance FZip         MyU1 where fzipWith  = gfzipWith+instance FRepeat      MyU1 where frepeat   = gfrepeat++instance FFunctor     MyV1 where ffmap     = ffmapDefault+instance FFoldable    MyV1 where ffoldMap  = ffoldMapDefault+instance FTraversable MyV1 where ftraverse = gftraverse++instance FZip         MyV1 where fzipWith  = gfzipWith++-------------------------------------------------------------------------------+-- Interesting+-------------------------------------------------------------------------------++data List f = Nil | Cons (Some f) (List f) deriving Generic++instance FFunctor     List where ffmap     = ffmapDefault+instance FFoldable    List where ffoldMap  = ffoldMapDefault+instance FTraversable List where ftraverse = gftraverse++-------------------------------------------------------------------------------+-- main+-------------------------------------------------------------------------------++main :: IO ()+main = print $ flength+    $ Cons (mkSome (Just 'x'))+    $ Cons (mkSome (Just True))+      Nil
+ hkd.cabal view
@@ -0,0 +1,95 @@+cabal-version:   2.2+name:            hkd+version:         0.1+synopsis:        "higher-kinded data"+description:+  "Higher-kinded data" utilities, e.g.+  .+  @+  class FFunctor t where+  \    ffmap :: (f ~> g) -> t f -> t g+  @+  .+  and other classes and types.+  .+  /Note:/ this package is experimental.++homepage:        https://github.com/ekmett/codex/tree/master/hkd#readme+license:         (BSD-2-Clause OR Apache-2.0)+license-file:    LICENSE.md+author:          Edward Kmett <ekmett@gmail.com>+maintainer:      Oleg Grenrus <oleg.grenrus@iki.fi>+copyright:       Copyright (c) 2019 Edward Kmett, 2019 Oleg Grenrus+category:        Data Structures+build-type:      Simple+extra-doc-files:+  README.md+  CHANGELOG.md++tested-with:+  GHC ==7.6.3+   || ==7.8.4+   || ==7.10.3+   || ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.1++source-repository head+  type:     git+  location: https://github.com/phadej/hkd+  subdir:   hkd++library+  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall+  exposed-modules:  Data.HKD+  other-modules:    Data.Functor.Confusing++  if impl(ghc >=8.0)+    ghc-options: -Wno-trustworthy-safe++  if impl(ghc >=8.4)+    ghc-options:+      -Wincomplete-uni-patterns -Wincomplete-record-updates+      -Wredundant-constraints -Widentities -Wmissing-export-lists++  build-depends:+    , base  >=4.6     && <4.14+    , some  ^>=1.0.0.3++  if !impl(ghc >=7.10)+    build-depends: transformers >=0.3 && <0.6++  if !impl(ghc >=8.0)+    build-depends: semigroups >=0.18.5 && <1++  if !impl(ghc >=7.8)+    build-depends: tagged >=0.8.5 && <1++test-suite example-np+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   example+  main-is:          NP.hs+  build-depends:+    , base+    , hkd++test-suite example-record+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   example+  main-is:          Record.hs++  -- build-depends: dump-core+  -- ghc-options:   -fplugin=DumpCore++  build-depends:+    , base+    , hkd+    , some
+ src/Data/Functor/Confusing.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Csongor Kiss, Matthew Pickering, and Nicolas Wu. 2018. Generic deriving of generic traversals.+-- Proc. ACM Program. Lang. 2, ICFP, Article 85 (July 2018), 30 pages. DOI: https://doi.org/10.1145/3236780+--+-- https://arxiv.org/abs/1805.06798+--+-- This is modified version of part of @generic-lens@ library+--+-- Copyright (c) 2018, Csongor Kiss+-- +-- 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 Csongor Kiss nor the names of other+--       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+-- OWNER 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.+-- +module Data.Functor.Confusing (+    confusing, LensLike,+    iconfusing, IxLensLike,+    fconfusing, FLensLike,+    liftCurriedYoneda, yap,+    Curried (..), liftCurried, lowerCurried,+    Yoneda (..), liftYoneda, lowerYoneda,+  ) where++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 0+#endif++#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative+#endif++-------------------------------------------------------------------------------+-- Confusing+-------------------------------------------------------------------------------++type LensLike f s t a b = (a -> f b) -> s -> f t++confusing :: Applicative f => LensLike (Curried (Yoneda f)) s t a b -> LensLike f s t a b+confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)+{-# INLINE confusing #-}++liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) a+liftCurriedYoneda fa = Curried (`yap` fa)+{-# INLINE liftCurriedYoneda #-}++yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b+yap (Yoneda k) fa = Yoneda (\ab_r -> k (ab_r .) <*> fa)+{-# INLINE yap #-}++type IxLensLike f i s t a b = (i -> a -> f b) -> s -> f t++iconfusing :: Applicative f => IxLensLike (Curried (Yoneda f)) i s t a b -> IxLensLike f i s t a b+iconfusing t = \f -> lowerYoneda . lowerCurried . t (\i a -> liftCurriedYoneda (f i a))+{-# INLINE iconfusing #-}++type FLensLike f s t a b = (forall x. a x -> f (b x)) -> s -> f t++fconfusing :: Applicative f => FLensLike (Curried (Yoneda f)) s t a b -> FLensLike f s t a b+fconfusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)+{-# INLINE fconfusing #-}++-------------------------------------------------------------------------------+-- Curried+-------------------------------------------------------------------------------++newtype Curried f a = Curried { runCurried :: forall r. f (a -> r) -> f r }++instance Functor f => Functor (Curried f) where+    fmap f (Curried g) = Curried (g . fmap (.f))+    {-# INLINE fmap #-}++instance Functor f => Applicative (Curried f) where+    pure a = Curried (fmap ($ a))+    {-# INLINE pure #-}+    Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))+    {-# INLINE (<*>) #-}++liftCurried :: Applicative f => f a -> Curried f a+liftCurried fa = Curried (<*> fa)++lowerCurried :: Applicative f => Curried f a -> f a+lowerCurried (Curried f) = f (pure id)++-------------------------------------------------------------------------------+-- Yoneda+-------------------------------------------------------------------------------++newtype Yoneda f a = Yoneda { runYoneda :: forall b. (a -> b) -> f b }++liftYoneda :: Functor f => f a -> Yoneda f a+liftYoneda a = Yoneda (\f -> fmap f a)++lowerYoneda :: Yoneda f a -> f a+lowerYoneda (Yoneda f) = f id++instance Functor (Yoneda f) where+    fmap f m = Yoneda (\k -> runYoneda m (k . f))++instance Applicative f => Applicative (Yoneda f) where+    pure a = Yoneda (\f -> pure (f a))+    Yoneda m <*> Yoneda n = Yoneda (\f -> m (f .) <*> n id)
+ src/Data/HKD.hs view
@@ -0,0 +1,701 @@+{-# language CPP #-}+{-# language FlexibleContexts #-}+{-# language FlexibleInstances #-}+{-# language GADTs #-}+{-# language MultiParamTypeClasses #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language Trustworthy #-}+{-# language TypeOperators #-}+#if !defined(HLINT) && MIN_VERSION_base(4,10,0) && __GLASGOW_HASKELL__ >= 708+{-# language LambdaCase #-}+{-# language EmptyCase #-}+#endif+-- |+-- Copyright :  (c) 2019 Edward Kmett, 2019 Oleg Grenrus+-- License   :  BSD-2-Clause OR Apache-2.0+-- Maintainer:  Oleg Grenrus <oleg.grenrus@iki.fi>+-- Stability :  experimental+-- Portability: non-portable+--+-- "Higher-Kinded Data" such as it is+module Data.HKD+(+-- * "Natural" transformation+   type (~>)+-- * Functor+, FFunctor(..)+-- * Contravariant+, FContravariant(..)+-- * Foldable+, FFoldable(..)+, flength+, ftraverse_+, ffor_+-- * Traversable+, FTraversable(..)+, ffmapDefault+, ffoldMapDefault+, ffor+, fsequence+-- ** Generic derivation+, gftraverse+-- * Zip & Repeat+, FZip (..)+, FRepeat (..)+-- ** Generic derivation+, gfzipWith+, gfrepeat+-- * Higher kinded data+-- | See also "Data.Some" in @some@ package. @hkd@ provides instances for it.+, Logarithm(..)+, Tab(..)+, indexLogarithm+, Element(..)+, NT(..)+, Limit(..)+) where++#if MIN_VERSION_base(4,9,0)+import Data.Kind (Type)+#else+#define Type *+#endif++import Control.Applicative+import qualified Data.Monoid as Monoid+import Data.Semigroup (Semigroup (..))+import Data.Proxy (Proxy (..))+import Data.Functor.Identity (Identity (..))+import Data.Monoid (Monoid (..))++import GHC.Generics+import Data.Functor.Confusing++-- In older base:s types aren't PolyKinded+#if MIN_VERSION_base(4,9,0)+import Data.Coerce (Coercible, coerce)+import Data.Functor.Compose (Compose (..))+import Data.Functor.Product (Product (..))+import Data.Functor.Sum (Sum (..))+#endif++import Data.Some.GADT (Some (..), mapSome, foldSome)+import qualified Data.Some.Newtype as N+import qualified Data.Some.Church as C++#if MIN_VERSION_base(4,9,0)+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(#.) _ = coerce++(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c+(.#) f _ = coerce f++infixr 9 #.+infixr 8 .#+#endif++-------------------------------------------------------------------------------+-- wiggly arrow+-------------------------------------------------------------------------------++type f ~> g = forall a. f a -> g a++-------------------------------------------------------------------------------+-- FFunctor+-------------------------------------------------------------------------------++class FFunctor (t :: (k -> Type) -> Type) where+  ffmap :: (f ~> g) -> t f -> t g++instance FFunctor Proxy where+  ffmap _ Proxy = Proxy++#if MIN_VERSION_base(4,9,0)+instance FFunctor (Const a) where+  ffmap _ (Const a) = Const a++instance (Functor f, FFunctor g) => FFunctor (Compose f g) where+  ffmap f = Compose #. fmap (ffmap f) .# getCompose++instance (FFunctor f, FFunctor g) => FFunctor (Product f g) where+  ffmap f (Pair g h) = Pair (ffmap f g) (ffmap f h)++instance (FFunctor f, FFunctor g) => FFunctor (Sum f g) where+  ffmap f (InL g) = InL (ffmap f g)+  ffmap f (InR h) = InR (ffmap f h)+#endif++#if MIN_VERSION_base(4,10,0)+instance FFunctor (K1 i a) where+  ffmap _ (K1 a) = K1 a++instance FFunctor U1 where+  ffmap _ U1 = U1++instance FFunctor V1 where+#ifndef HLINT+  ffmap _ = \case+#endif++instance (Functor f, FFunctor g) => FFunctor (f :.: g) where+  ffmap f = Comp1 #. fmap (ffmap f) .# unComp1++instance (FFunctor f, FFunctor g) => FFunctor (f :*: g) where+  ffmap f (g :*: h) = ffmap f g :*: ffmap f h++instance (FFunctor f, FFunctor g) => FFunctor (f :+: g) where+  ffmap f (L1 g) = L1 (ffmap f g)+  ffmap f (R1 h) = R1 (ffmap f h)+#endif++-------------------------------------------------------------------------------+-- FFoldable+-------------------------------------------------------------------------------++class FFoldable (t :: (k -> Type) -> Type) where+  ffoldMap :: Monoid.Monoid m => (forall a. f a -> m) -> t f -> m++  flengthAcc :: Int -> t f -> Int+  flengthAcc acc t = acc + Monoid.getSum (ffoldMap (\_ -> Monoid.Sum 1) t)++flength :: FFoldable t => t f -> Int+flength = flengthAcc 0++ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m ()+ftraverse_ k tf = N.withSome (ffoldMap (N.mkSome . k) tf) (() <$)++ffor_ :: (FFoldable t, Applicative m) => t f -> (forall a. f a -> m b) -> m ()+ffor_ tf k = ftraverse_ k tf++instance FFoldable Proxy where+  ffoldMap _ = Data.Monoid.mempty+  flengthAcc = const++#if MIN_VERSION_base(4,9,0)+instance FFoldable (Const a) where+  ffoldMap _ = mempty+  flengthAcc = const++instance (Foldable f, FFoldable g) => FFoldable (Compose f g) where+  ffoldMap f = foldMap (ffoldMap f) .# getCompose++instance (FFoldable f, FFoldable g) => FFoldable (Product f g) where+  ffoldMap f (Pair g h) = ffoldMap f g `mappend` ffoldMap f h+  flengthAcc f (Pair g h) = f `flengthAcc` g `flengthAcc` h++instance (FFoldable f, FFoldable g) => FFoldable (Sum f g) where+  ffoldMap f (InL g) = ffoldMap f g+  ffoldMap f (InR h) = ffoldMap f h+#endif++#if MIN_VERSION_base(4,10,0)+instance FFoldable V1 where+#ifndef HLINT+  ffoldMap _ = \case+  flengthAcc _ = \case+#endif++instance FFoldable (K1 i a) where+  ffoldMap _ = mempty+  flengthAcc = const++instance FFoldable U1 where+  ffoldMap _ = mempty+  flengthAcc = const++instance (Foldable f, FFoldable g) => FFoldable (f :.: g) where+  ffoldMap f = foldMap (ffoldMap f) .# unComp1++instance (FFoldable f, FFoldable g) => FFoldable (f :*: g) where+  ffoldMap f (g :*: h) = ffoldMap f g `mappend` ffoldMap f h+  flengthAcc acc (g :*: h) = acc `flengthAcc` g `flengthAcc` h++instance (FFoldable f, FFoldable g) => FFoldable (f :+: g) where+  ffoldMap f (L1 g) = ffoldMap f g+  ffoldMap f (R1 h) = ffoldMap f h+  flengthAcc acc (L1 g) = flengthAcc acc g+  flengthAcc acc (R1 g) = flengthAcc acc g+#endif++-------------------------------------------------------------------------------+-- FTraversable+-------------------------------------------------------------------------------++class (FFoldable t, FFunctor t) => FTraversable (t :: (k -> Type) -> Type) where+  ftraverse :: Applicative m => (forall a. f a -> m (g a)) -> t f -> m (t g)++ffmapDefault :: FTraversable t =>  (f ~> g) -> t f -> t g+ffmapDefault k = runIdentity . ftraverse (Identity . k)++ffoldMapDefault :: (FTraversable t, Monoid m) =>  (forall a. f a -> m) -> t f -> m+ffoldMapDefault k = getConst . ftraverse (Const . k)++ffor :: (FTraversable t, Applicative m) => t f -> (forall a. f a -> m (g a)) -> m (t g)+ffor tf k = ftraverse k tf++fsequence :: (FTraversable t, Applicative f) => t f -> f (t Identity)+fsequence = ftraverse (fmap Identity)++instance FTraversable Proxy where+  ftraverse _ Proxy = pure Proxy++#if MIN_VERSION_base(4,9,0)+instance FTraversable (Const a) where+  ftraverse _ = pure .# (Const . getConst)++instance (Traversable f, FTraversable g) => FTraversable (Compose f g) where+  ftraverse f = fmap Compose . traverse (ftraverse f) .# getCompose++instance (FTraversable f, FTraversable g) => FTraversable (Product f g) where+  ftraverse f (Pair g h) = Pair <$> ftraverse f g <*> ftraverse f h++instance (FTraversable f, FTraversable g) => FTraversable (Sum f g) where+  ftraverse f (InL g) = InL <$> ftraverse f g+  ftraverse f (InR h) = InR <$> ftraverse f h+#endif++#if MIN_VERSION_base(4,10,0)+instance FTraversable U1 where+  ftraverse _ U1 = pure U1++instance FTraversable V1 where+#ifndef HLINT+  ftraverse _ = \case+#endif++instance FTraversable (K1 i a) where+  ftraverse _ = pure .# (K1 . unK1)++instance (Traversable f, FTraversable g) => FTraversable (f :.: g) where+  ftraverse f = fmap Comp1 . traverse (ftraverse f) .# unComp1++instance (FTraversable f, FTraversable g) => FTraversable (f :*: g) where+  ftraverse f (g :*: h) = (:*:) <$> ftraverse f g <*> ftraverse f h++instance (FTraversable f, FTraversable g) => FTraversable (f :+: g) where+  ftraverse f (L1 g) = L1 <$> ftraverse f g+  ftraverse f (R1 h) = R1 <$> ftraverse f h+#endif++-------------------------------------------------------------------------------+-- FZip+-------------------------------------------------------------------------------++class FFunctor t => FZip t where+    fzipWith :: (forall x. f x -> g x -> h x) -> t f -> t g -> t h++class FZip t => FRepeat t where+    frepeat :: (forall x. f x) -> t f++instance FZip Proxy where+    fzipWith _ _ _ = Proxy++instance FRepeat Proxy where+    frepeat _ = Proxy++instance FZip (Element a) where+    fzipWith f (Element x) (Element y) = Element (f x y)++instance FRepeat (Element a) where+    frepeat x = Element x++instance FZip (NT f) where+    fzipWith f (NT g) (NT h) = NT $ \x -> f (g x) (h x)++instance FRepeat (NT a) where+    frepeat x = NT $ \_ -> x++instance FZip Limit where+    fzipWith f (Limit x) (Limit y) = Limit (f x y)++instance FRepeat Limit where+    frepeat x = Limit x++#if MIN_VERSION_base(4,9,0)+instance Data.Semigroup.Semigroup a => FZip (Const a) where+  fzipWith _ (Const a) (Const b) = Const (a <> b)++instance (Monoid a, Semigroup a) => FRepeat (Const a) where+  frepeat _ = Const mempty++instance (FZip f, FZip g) => FZip (Product f g) where+  fzipWith f (Pair x y) (Pair x' y') = Pair (fzipWith f x x') (fzipWith f y y')++instance (FRepeat f, FRepeat g) => FRepeat (Product f g) where+  frepeat x = Pair (frepeat x) (frepeat x)++-- | We only need an 'Apply' part of an 'Applicative'.+instance (Applicative f, FZip g) => FZip (Compose f g) where+  fzipWith f (Compose x) (Compose y) = Compose (liftA2 (fzipWith f) x y)++instance (Applicative f, FRepeat g) => FRepeat (Compose f g) where+  frepeat x = Compose (pure (frepeat x))+#endif++#if MIN_VERSION_base(4,10,0)+instance FZip U1 where+  fzipWith _ _ _ =  U1++instance FRepeat U1 where+  frepeat _ = U1++instance FZip V1 where+  fzipWith _ x _ = case x of++instance Data.Semigroup.Semigroup a => FZip (K1 i a) where+  fzipWith _ (K1 a) (K1 b) = K1 (a <> b)++instance (Monoid a, Semigroup a) => FRepeat (K1 i a) where+  frepeat _ = K1 mempty++instance (FZip f, FZip g) => FZip (f :*: g) where+  fzipWith f (x :*: y) (x' :*: y') = fzipWith f x x' :*: fzipWith f y y'++instance (FRepeat f, FRepeat g) => FRepeat (f :*: g) where+  frepeat x = frepeat x :*: frepeat x++-- | We only need an 'Apply' part of an 'Applicative'.+instance (Applicative f, FZip g) => FZip (f :.: g) where+  fzipWith f (Comp1 x) (Comp1 y) = Comp1 (liftA2 (fzipWith f) x y)++instance (Applicative f, FRepeat g) => FRepeat (f :.: g) where+  frepeat x = Comp1 (pure (frepeat x))+#endif+++-------------------------------------------------------------------------------+-- FContravariant+-------------------------------------------------------------------------------++class FContravariant (t :: (k -> Type) -> Type) where+  fcontramap :: (f ~> g) -> t g -> t f++instance FContravariant Proxy where+  fcontramap _ Proxy = Proxy++#if MIN_VERSION_base(4,9,0)+instance FContravariant (Const a) where+  fcontramap _ (Const a) = Const a++instance (Functor f, FContravariant g) => FContravariant (Compose f g) where+  fcontramap f = Compose #. fmap (fcontramap f) .# getCompose++instance (FContravariant f, FContravariant g) => FContravariant (Product f g) where+  fcontramap f (Pair g h) = Pair (fcontramap f g) (fcontramap f h)++instance (FContravariant f, FContravariant g) => FContravariant (Sum f g) where+  fcontramap f (InL g) = InL (fcontramap f g)+  fcontramap f (InR h) = InR (fcontramap f h)+#endif++#if MIN_VERSION_base(4,10,0)+instance FContravariant (K1 i a) where+  fcontramap _ (K1 a) = K1 a+++instance FContravariant U1 where+  fcontramap _ U1 = U1++instance FContravariant V1 where+#ifndef HLINT+  fcontramap _ = \case+#endif++instance (Functor f, FContravariant g) => FContravariant (f :.: g) where+  fcontramap f = Comp1 #. fmap (fcontramap f) .# unComp1++instance (FContravariant f, FContravariant g) => FContravariant (f :*: g) where+  fcontramap f (g :*: h) = fcontramap f g :*: fcontramap f h++instance (FContravariant f, FContravariant g) => FContravariant (f :+: g) where+  fcontramap f (L1 g) = L1 (fcontramap f g)+  fcontramap f (R1 h) = R1 (fcontramap f h)+#endif++-------------------------------------------------------------------------------+-- distributive utilities+-------------------------------------------------------------------------------++-- | A logarithm.+--+-- Recall that function arrow, @->@ is an exponential object. If we take @f = (->) r@, then+--+-- @+-- 'Logarithm' ((->) r) ≅ forall a. (r -> a) -> a ≅ r+-- @+--+-- and this works for all 'Distributive' / 'Representable' functors.+--+newtype Logarithm f = Logarithm { runLogarithm :: forall a. f a -> a }++indexLogarithm :: f a -> Logarithm f -> a+indexLogarithm fa (Logarithm fa2a) = fa2a fa++instance FContravariant Logarithm where+  fcontramap f g = Logarithm (runLogarithm g . f)++-- | Tabulation.+newtype Tab a f = Tab { runTab :: Logarithm f -> a }++instance FFunctor (Tab a) where+  ffmap f g = Tab (runTab g . fcontramap f)++-------------------------------------------------------------------------------+-- Elements+-------------------------------------------------------------------------------++-- | Element in @f@+newtype Element a f = Element { runElement :: f a }++instance FFunctor (Element a) where+  ffmap f (Element fa) = Element (f fa)++instance FFoldable (Element a) where+  ffoldMap f (Element fa) = f fa+  flengthAcc acc _ = acc + 1++instance FTraversable (Element a) where+  ftraverse f (Element g) = Element <$> f g++-------------------------------------------------------------------------------+-- "natural" transformations via parametricity+-------------------------------------------------------------------------------++-- | Newtyped "natural" transformation+newtype NT f g = NT { runNT :: f ~> g }++instance FFunctor (NT f) where+  ffmap f (NT g) = NT (f . g)++-------------------------------------------------------------------------------+-- Some+-------------------------------------------------------------------------------++instance FFunctor Some where+  ffmap = mapSome++instance FFoldable Some where+  ffoldMap = foldSome+  flengthAcc len _ = len + 1++instance FTraversable Some where+  ftraverse f (Some m) = Some <$> f m++instance FFunctor N.Some where+  ffmap = N.mapSome++instance FFoldable N.Some where+  ffoldMap = N.foldSome+  flengthAcc len _ = len + 1++instance FTraversable N.Some where+  ftraverse f x = N.withSome x $ \x' -> N.mkSome <$> f x'++instance FFunctor C.Some where+  ffmap = C.mapSome++instance FFoldable C.Some where+  ffoldMap = C.foldSome+  flengthAcc len _ = len + 1++instance FTraversable C.Some where+  ftraverse f x = C.withSome x $ \x' -> C.mkSome <$> f x'++-------------------------------------------------------------------------------+-- Limit+-------------------------------------------------------------------------------++newtype Limit f = Limit { runLimit :: forall a. f a }++instance FFunctor Limit where+  ffmap f (Limit g) = Limit (f g)++instance FFoldable Limit where+  ffoldMap f (Limit g) = f g+  flengthAcc len _ = len + 1++-------------------------------------------------------------------------------+-- Generic ftraverse+-------------------------------------------------------------------------------++-- | Generically derive 'ftraverse'.+--+-- Simple usage:+--+-- @+-- data Record f = Record+--     { fieldInt    :: f Int+--     , fieldString :: f String+--     , fieldSome   :: 'Some' f+--     }+--   deriving ('Generic')+--+-- instance 'FFunctor'     Record where 'ffmap'     = 'ffmapDefault'+-- instance 'FFoldable'    Record where 'ffoldMap'  = 'ffoldMapDefault'+-- instance 'FTraversable' Record where 'ftraverse' = 'gftraverse'+-- @++gftraverse+  :: forall t (f :: Type -> Type) (g :: Type -> Type) m. (Applicative m, Generic (t f), Generic (t g), GFTraversable (Curried (Yoneda m)) f g (Rep (t f)) (Rep (t g)))+  => (forall a. f a -> m (g a))+  -> t f+  -> m (t g)+gftraverse = fconfusing impl+  where+  impl :: FLensLike (Curried (Yoneda m)) (t f) (t g) f g+  impl nt = fmap to . gftraverse0 nt . from+{-# INLINE gftraverse #-}++class GFTraversable m f g tf tg where+  gftraverse0 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())++instance (i ~ D, i' ~ D, Functor m, GFTraversable1 m f g h h') => GFTraversable m f g (M1 i c h) (M1 i' c' h') where+  gftraverse0 nt = fmap M1 . gftraverse1 nt . unM1+  {-# INLINE gftraverse0 #-}++class GFTraversable1 m f g tf tg where+  gftraverse1 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())++instance GFTraversable1 m f g V1 V1 where+  gftraverse1 _ x = x `seq` error "Void is conjured"+  {-# INLINE gftraverse1 #-}++instance (Applicative m, GFTraversable1 m f g x x', GFTraversable1 m f g y y') => GFTraversable1 m f g (x :+: y) (x' :+: y') where+  gftraverse1 nt (L1 x) = fmap L1 (gftraverse1 nt x)+  gftraverse1 nt (R1 y) = fmap R1 (gftraverse1 nt y)+  {-# INLINE gftraverse1 #-}++instance (i ~ C, i' ~ C, Functor m, GFTraversable2 m f g h h') => GFTraversable1 m f g (M1 i c h) (M1 i' c' h') where+  gftraverse1 nt = fmap M1 . gftraverse2 nt . unM1+  {-# INLINE gftraverse1 #-}++class GFTraversable2 m f g tf tg where+  gftraverse2 :: (forall a. f a -> m (g a)) -> tf () -> m (tg ())++instance Applicative m  => GFTraversable2 m f g U1 U1 where+  gftraverse2 _ _ = pure U1+  {-# INLINE gftraverse2 #-}++instance (i ~ S, i' ~ S, Functor m, GFTraversable2 m f g h h') => GFTraversable2 m f g (M1 i c h) (M1 i' c' h') where+  gftraverse2 nt = fmap M1 . gftraverse2 nt . unM1+  {-# INLINE gftraverse2 #-}++instance (Applicative m, GFTraversable2 m f g x x', GFTraversable2 m f g y y') => GFTraversable2 m f g (x :*: y) (x' :*: y') where+  gftraverse2 nt (x :*: y) = liftA2 (:*:) (gftraverse2 nt x) (gftraverse2 nt y)+  {-# INLINE gftraverse2 #-}++instance (f ~ f', g ~ g', x ~ x', i ~ R, i' ~ R, Functor m) => GFTraversable2 m f g (K1 i (f' x)) (K1 i' (g' x')) where+  gftraverse2 nt = fmap K1 . nt . unK1+  {-# INLINE gftraverse2 #-}++instance (f ~ f', g ~ g', t ~ t', i ~ R, i' ~ R, Applicative m, FTraversable t) => GFTraversable2 m f g (K1 i (t f')) (K1 i' (t' g')) where+  gftraverse2 nt = fmap K1 . ftraverse nt . unK1+  {-# INLINE gftraverse2 #-}+++-------------------------------------------------------------------------------+-- Generic fzipWith+-------------------------------------------------------------------------------++-- | Generically derive 'fzipWith'.+--+-- Simple usage:+--+-- @+-- data Record f = Record+--     { fieldInt    :: f Int+--     , fieldString :: f String+--     }+--   deriving ('Generic')+--+-- instance 'FZip'    Record where 'fzipWith' = 'gfzipWith'+-- instance 'FRepeat' Record where 'frepeat'  = 'gfrepeat'+-- @++gfzipWith+  :: forall t (f :: Type -> Type) (g :: Type -> Type) (h :: Type -> Type). (Generic (t f), Generic (t g), Generic (t h), GFZip f g h (Rep (t f)) (Rep (t g)) (Rep (t h)))+  => (forall a. f a -> g a -> h a)+  -> t f+  -> t g+  -> t h+gfzipWith nt x y = to (gfzipWith0 nt (from x) (from y))+{-# INLINE gfzipWith #-}++class GFZip f g h tf tg th where+  gfzipWith0 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()++instance (i0 ~ D, i1 ~ D, i2 ~ D, GFZip1 f g h t0 t1 t2) => GFZip f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where+  gfzipWith0 nt x y = M1 (gfzipWith1 nt (unM1 x) (unM1 y))+  {-# INLINE gfzipWith0 #-}++class GFZip1 f g h tf tg th where+  gfzipWith1 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()++instance GFZip1 f g h V1 V1 V1 where+  gfzipWith1 _ x _ = x `seq` error "Void is conjured"++instance (i0 ~ C, i1 ~ C, i2 ~ C, GFZip2 f g h t0 t1 t2) => GFZip1 f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where+  gfzipWith1 nt x y = M1 (gfzipWith2 nt (unM1 x) (unM1 y))+  {-# INLINE gfzipWith1 #-}++class GFZip2 f g h tf tg th where+  gfzipWith2 :: (forall a. f a -> g a -> h a) -> tf () -> tg () -> th ()++instance GFZip2 f g h U1 U1 U1 where+  gfzipWith2 _ _ _ = U1++instance (GFZip2 f g h tf tg th, GFZip2 f g h sf sg sh) => GFZip2 f g h (tf :*: sf) (tg :*: sg) (th :*: sh) where+  gfzipWith2 nt (x :*: y) (x' :*: y') = gfzipWith2 nt x x' :*: gfzipWith2 nt y y'+  {-# INLINE gfzipWith2 #-}++instance (i0 ~ S, i1 ~ S, i2 ~ S, GFZip2 f g h t0 t1 t2) => GFZip2 f g h (M1 i0 c0 t0) (M1 i1 c1 t1) (M1 i2 c2 t2) where+  gfzipWith2 nt x y = M1 (gfzipWith2 nt (unM1 x) (unM1 y))+  {-# INLINE gfzipWith2 #-}++instance (f ~ f', g ~ g', h ~ h', x0 ~ x1, x1 ~ x2, i0 ~ R, i1 ~ R, i2 ~ R) => GFZip2 f g h (K1 i0 (f' x0)) (K1 i1 (g' x1)) (K1 i2 (h' x2)) where+  gfzipWith2 nt (K1 x) (K1 y) = K1 (nt x y)++instance (f ~ f', g ~ g', h ~ h', t0 ~ t1, t1 ~ t2, i0 ~ R, i1 ~ R, i2 ~ R, FZip t0) => GFZip2 f g h (K1 i0 (t0 f')) (K1 i1 (t1 g')) (K1 i2 (t2 h')) where+  gfzipWith2 nt (K1 x) (K1 y) = K1 (fzipWith nt x y)++-------------------------------------------------------------------------------+-- Generic frepeat+-------------------------------------------------------------------------------++gfrepeat+  :: forall t (f :: Type -> Type). (Generic (t f), GFRepeat f (Rep (t f)))+  => (forall x. f x)+  -> t f+gfrepeat x = to (gfrepeat0 x)++class GFRepeat f tf where+  gfrepeat0 :: (forall a. f a) -> tf ()++instance (i ~ D, GFRepeat1 g f) => GFRepeat g (M1 i c f) where+  gfrepeat0 x = M1 (gfrepeat1 x)++class GFRepeat1 f tf where+  gfrepeat1 :: (forall a. f a) -> tf ()++instance (i ~ C, GFRepeat2 g f) => GFRepeat1 g (M1 i c f) where+  gfrepeat1 x = M1 (gfrepeat2 x)++class GFRepeat2 f tf where+  gfrepeat2 :: (forall a. f a) -> tf ()++instance (i ~ S, GFRepeat2 g f) => GFRepeat2 g (M1 i c f) where+  gfrepeat2 x = M1 (gfrepeat2 x)++instance (GFRepeat2 f x, GFRepeat2 f y) => GFRepeat2 f (x :*: y) where+  gfrepeat2 x = gfrepeat2 x :*: gfrepeat2 x++instance GFRepeat2 f U1 where+  gfrepeat2 _ = U1++instance (i ~ R, f ~ f') => GFRepeat2 f (K1 i (f' x)) where+  gfrepeat2 x = K1 x++instance (i ~ R, f ~ f', FRepeat t) => GFRepeat2 f (K1 i (t f')) where+  gfrepeat2 x = K1 (frepeat x)