multicurryable (empty) → 0.1.0.0

raw patch · 5 files changed

+283/−0 lines, 5 filesdep +basedep +multicurryabledep +sop-core

Dependencies added: base, multicurryable, sop-core

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• lib/Multicurryable.hs +138/−0
• multicurryable.cabal +59/−0
• test/Main.hs +51/−0

@@ -0,0 +1,5 @@+# Revision history for bunchable++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2022, Daniel Díaz++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 Daniel Díaz 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.

@@ -0,0 +1,138 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | While writing function decorators, we often need to store the arguments+-- of the function in a n-ary product. @'multiuncurry' \@(<-)@ is useful for that.   +--+-- Less often, when processing the result of functions, we have a nested chain+-- of 'Either's like @Either Err1 (Either Err2 (Either Err3 Success))@, and want to put all the errors in a top-level 'Left' branch,+-- and the lone @Success@ value in a top-level 'Right' branch. @'multiuncurry' \@Either@ is useful for that.   +-- +-- The 'Multicurryable' class will get terribly confused if it can't determine+-- the rightmost type, because it can't be sure it's not another @(->)@, or+-- another @Either@. So use it only with concrete rightmost types, not+-- polymorphic ones.+-- +module Multicurryable (+    -- * Multi-argument currying/uncurrying.+    Multicurryable (..),+    -- * sop-core re-exports+    NP (..),+    NS (..),+    I (..),+  ) where++import Data.Kind+import Data.SOP+import Data.SOP.NP+import Data.SOP.NS++type Multicurryable :: (Type -> Type -> Type) -> [Type] -> Type -> Type -> Constraint+class+  Multicurryable (f :: Type -> Type -> Type) (items :: [Type]) a curried+    | f items a -> curried,+      f curried -> items a+  where+  type UncurriedArgs f :: [Type] -> Type+  multiuncurry :: curried -> f (UncurriedArgs f items) a+  multicurry :: f (UncurriedArgs f items) a -> curried++-- Instance for (->)++type family IsFunction f :: Bool where+  IsFunction (_ -> _) = 'True+  IsFunction _ = 'False++-- | The instance for functions provides conventional currying/uncurrying, only+-- that it works for multiple arguments, and the uncurried arguments are stored+-- in a 'NP' product instead of a tuple.+instance+  MulticurryableF (IsFunction curried) items a curried =>+  Multicurryable (->) items a curried+  where+  type UncurriedArgs (->) = NP I+  multiuncurry = multiuncurryF @(IsFunction curried)+  multicurry = multicurryF @(IsFunction curried)++class+  MulticurryableF (b :: Bool) items a curried+    | items a -> curried,+      b curried -> items a +  where+  multiuncurryF :: curried -> NP I items -> a+  multicurryF :: (NP I items -> a) -> curried++instance MulticurryableF 'False '[] a a where+  multiuncurryF a Nil = a+  multicurryF f = f Nil++instance+  MulticurryableF (IsFunction curried) rest tip curried =>+  MulticurryableF 'True (i ': rest) tip (i -> curried)+  where+  multiuncurryF f (I x :* rest) =+    multiuncurryF @(IsFunction curried) @rest @tip @curried (f x) rest+  multicurryF f i =+    multicurryF @(IsFunction curried) @rest @tip @curried $ \rest -> f (I i :* rest)++-- Instance for Either++type family IsEither f :: Bool where+  IsEither (Either _ _) = 'True+  IsEither _ = 'False+++-- | The instance for 'Either' takes a sequence nested 'Either's, separates the+-- errors from the success value at the right tip, and stores any occurring+-- errors in a 'NS' sum.+instance+  MulticurryableE (IsEither curried) items a curried =>+  Multicurryable Either items a curried+  where+  type UncurriedArgs Either = NS I+  multiuncurry = multiuncurryE @(IsEither curried)+  multicurry = multicurryE @(IsEither curried)++class+  MulticurryableE (b :: Bool) items a curried+    | items a -> curried,+      b curried -> items a+  where+  multiuncurryE :: curried -> Either (NS I items) a+  multicurryE :: Either (NS I items) a -> curried++instance MulticurryableE 'False '[] a a where+  multiuncurryE = Right+  multicurryE = \case+    Left impossible -> case impossible of {}+    Right a -> a++instance+  MulticurryableE (IsEither curried) rest tip curried =>+  MulticurryableE 'True (i ': rest) tip (Either i curried)+  where+  multiuncurryE = \case+    Left x -> Left (Z (I x))+    Right rest ->+      case multiuncurryE @(IsEither curried) @rest @tip @curried rest of+        Left ns -> Left (S ns)+        Right x -> Right x+  multicurryE = \case+    Left rest -> case rest of+      Z (I x) -> Left x+      S rest' -> Right $ multicurryE @(IsEither curried) @_ @tip @curried (Left rest')+    Right tip -> Right $ multicurryE @(IsEither curried) @_ @tip @curried (Right tip)++-- $setup+-- >>> :set -XAllowAmbiguousTypes+-- >>> :set -XDataKinds +-- >>> :set -XFunctionalDependencies +-- >>> :set -XLambdaCase +-- >>> :set -XTypeFamilies+-- >>> :set -XTypeOperators+-- >>> :set -XUndecidableInstances 

@@ -0,0 +1,59 @@+cabal-version:      3.0+name:               multicurryable+version:            0.1.0.0+synopsis:           Uncurry functions with multiple arguments.+description:        This library provides a version of "uncurry" which takes a+                    function of multiple arguments and stores the arguments into an n-ary product+                    from "sop-core". The first non-function type encountered in the signature is +                    considered the "end of the function".+                     +                    This library also provides a way of reassociating a sequence of nested Eithers,+                    so that the innermost Rigth value floats to the top-level Right branch.+license:            BSD-3-Clause+license-file:       LICENSE+author:             Daniel Díaz+maintainer:         diaz_carrete@yahoo.com+-- copyright:+category:           Data+build-type:         Simple+extra-doc-files:    CHANGELOG.md+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  Multicurryable+    -- other-modules:+    -- other-extensions:+    build-depends:    +        base >= 4.16 && < 5,+        sop-core ^>= 0.5.0.2,+    hs-source-dirs:   lib+    default-language: GHC2021++test-suite multicurryable-test+    import:           warnings+    default-language: GHC2021+    -- other-modules:+    -- other-extensions:+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base >= 4.16 && < 5,+        sop-core ^>= 0.5.0.2,+        multicurryable++-- test-suite doctests+--   import:              warnings+--   type:                exitcode-stdio-1.0+--   hs-source-dirs:      doctest+--   main-is:             Main.hs+--   build-depends:       +--         base >= 4.16 && < 5,+--         sop-core ^>= 0.5.0.2,+--         doctest,+--         multicurryable,+--   default-language:    GHC2021

@@ -0,0 +1,51 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE BlockArguments #-}+module Main (main) where++import Multicurryable+import Data.SOP.NP+import Data.SOP.NS+import Data.Functor.Identity++type Fun0 = Int+type Fun0b = IO Int+type Fun1 = Bool -> Int+type Fun1b = Bool -> IO Int+type Fun2 = Char -> Bool -> Int+type Fun2b = Char -> Bool -> IO Int++-- Signatures omitted to check type inference+ufun0 = multiuncurry @(->) @_ @_ @Fun0 5+ufun0b = multiuncurry @(->) @_ @_ @Fun0b (pure 5)+ufun1 = multiuncurry @(->) @_ @_ @Fun1 \_ -> 5+ufun1b = multiuncurry @(->) @_ @_ @Fun1b \_ -> pure 5+ufun2 = multiuncurry @(->) @_ @_ @Fun2 \_ _ -> 5+ufun2b = multiuncurry @(->) @_ @_ @Fun2b \_ _ -> pure 5++fun0 = multicurry @(->) @_ @_ ufun0 +fun0b = multicurry @(->) @_ @_ ufun0b+fun1 = multicurry @(->) @_ @_ ufun1 +fun1b = multicurry @(->) @_ @_ ufun1b+fun2 = multicurry @(->) @_ @_ ufun2+fun2b = multicurry @(->) @_ @_ ufun2b+++type Eith0 = Int+type Eith1 = Either Bool Int+type Eith2 = Either Char (Either Bool Int)++ueith0 = multiuncurry @Either @_ @_ @Eith0 5+ueith1 = multiuncurry @Either @_ @_ @Eith1 $ Right 5+ueith2 = multiuncurry @Either @_ @_ @Eith2 $ Right (Right 5)++eith0 = multicurry @Either @_ @_ ueith0+eith1 = multicurry @Either @_ @_ ueith1+eith2 = multicurry @Either @_ @_ ueith2++main :: IO ()+main = putStrLn "Test suite not yet implemented."