contravariant-extras 0.3.4 → 0.3.5.4
raw patch · 9 files changed
Files
- Setup.hs +0/−2
- contravariant-extras.cabal +69/−45
- library/Contravariant/Extras.hs +18/−17
- library/Contravariant/Extras/Contrazip.hs +4/−7
- library/Contravariant/Extras/ContrazipLifting.hs +31/−0
- library/Contravariant/Extras/Op.hs +4/−5
- library/Contravariant/Extras/Op/Contrazip.hs +4/−7
- library/Contravariant/Extras/Prelude.hs +71/−0
- library/Contravariant/Extras/TH.hs +87/−102
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
contravariant-extras.cabal view
@@ -1,58 +1,82 @@-name:- contravariant-extras-version:- 0.3.4-category:- Control-synopsis:- Extras for the "contravariant" package-homepage:- https://github.com/nikita-volkov/contravariant-extras +name: contravariant-extras+version: 0.3.5.4+category: Control+synopsis: Extras for the "contravariant" package+description:+ Utilities for contravariant functors.+ Provides large sets of functions for contravariant composition+ of various arities.++homepage: https://github.com/nikita-volkov/contravariant-extras bug-reports:- https://github.com/nikita-volkov/contravariant-extras/issues -author:- Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:- Nikita Volkov <nikita.y.volkov@mail.ru>-copyright:- (c) 2015, Nikita Volkov-license:- MIT-license-file:- LICENSE-build-type:- Simple-cabal-version:- >=1.10+ https://github.com/nikita-volkov/contravariant-extras/issues +author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2015, Nikita Volkov+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10 source-repository head- type:- git- location:- git://github.com/nikita-volkov/contravariant-extras.git-+ type: git+ location: git://github.com/nikita-volkov/contravariant-extras.git library- hs-source-dirs:- library- ghc-options:+ hs-source-dirs: library default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language:- Haskell2010- other-modules:- Contravariant.Extras.TH+ NoImplicitPrelude+ NoMonomorphismRestriction+ Arrows+ BangPatterns+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ EmptyDataDecls+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ LiberalTypeSynonyms+ MagicHash+ MultiParamTypeClasses+ MultiWayIf+ OverloadedStrings+ ParallelListComp+ PatternGuards+ QuasiQuotes+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeFamilies+ TypeOperators+ UnboxedTuples++ default-language: Haskell2010 exposed-modules: Contravariant.Extras Contravariant.Extras.Contrazip+ Contravariant.Extras.ContrazipLifting Contravariant.Extras.Op Contravariant.Extras.Op.Contrazip- build-depends:- base >= 4 && < 4.12,- tuple-th >= 0.2.5 && < 0.3,- template-haskell >= 2.8 && < 3,- contravariant >= 1.3 && < 2,- base-prelude >= 0.1.19 && < 2,- semigroups >= 0.8.4 && < 1 + other-modules:+ Contravariant.Extras.Prelude+ Contravariant.Extras.TH++ build-depends:+ base >=4.10 && <5+ , contravariant >=1.3 && <2+ , template-haskell >=2.8 && <3+ , template-haskell-compat-v0208 >=0.1.9.3 && <2
library/Contravariant/Extras.hs view
@@ -1,28 +1,29 @@ module Contravariant.Extras-(- -- |- -- A berserk collection of @contrazip@ functions with arities of up to 42.- module Contravariant.Extras.Contrazip,- (>*<),- contramany,- Supplied(..),-)+ ( -- |+ -- @contrazip@ functions of multiple arities.+ module Contravariant.Extras.Contrazip,+ -- |+ -- @contrazipLifting@ functions of multiple arities.+ module Contravariant.Extras.ContrazipLifting,+ (>*<),+ contramany,+ Supplied (..),+ ) where -import BasePrelude hiding ((<>)) import Contravariant.Extras.Contrazip-import Data.Functor.Contravariant.Divisible+import Contravariant.Extras.ContrazipLifting+import Contravariant.Extras.Prelude hiding ((<>)) import Data.Semigroup (Semigroup ((<>))) - -- | -- An alias to 'divided'. {-# INLINE (>*<) #-}-(>*<) :: Divisible f => f a -> f b -> f (a, b)+(>*<) :: (Divisible f) => f a -> f b -> f (a, b) (>*<) = divided -contramany :: Decidable f => f a -> f [a]+contramany :: (Decidable f) => f a -> f [a] contramany f = loop where@@ -43,10 +44,10 @@ -- | -- A combination of a divisible functor with some input for it. -- Allows to use the 'Monoid' API for composition.-data Supplied divisible =- forall input. Supplied !(divisible input) !input+data Supplied divisible+ = forall input. Supplied (divisible input) input -instance Divisible divisible => Semigroup (Supplied divisible) where+instance (Divisible divisible) => Semigroup (Supplied divisible) where Supplied divisible1 input1 <> Supplied divisible2 input2 = Supplied divisible3 input3 where@@ -55,7 +56,7 @@ input3 = (input1, input2) -instance Divisible divisible => Monoid (Supplied divisible) where+instance (Divisible divisible) => Monoid (Supplied divisible) where mempty = Supplied conquer () mappend =
library/Contravariant/Extras/Contrazip.hs view
@@ -1,21 +1,18 @@ -- | -- A berserk collection of @contrazip@ functions with arities of up to 42.--- +-- -- Why 42? -- Well, naturally, because it's the answer to the ultimate question of life, -- the universe and everything.--- +-- -- It's exported as a separate module from "Contravariant.Extras" -- only to not pollute its documentation. -- The "Contravariant.Extras" module still reexports this module, -- so you can simply import that only.--- module Contravariant.Extras.Contrazip where -import BasePrelude+import Contravariant.Extras.Prelude import qualified Contravariant.Extras.TH as TH - -- Generate the @contrazip@ functions:-return (join (map (TH.divisibleContrazipDecs "contrazip") (reverse [2..42])))-+return (join (map (TH.contrazipDecs "contrazip") (reverse [2 .. 42])))
+ library/Contravariant/Extras/ContrazipLifting.hs view
@@ -0,0 +1,31 @@+module Contravariant.Extras.ContrazipLifting where++import Contravariant.Extras.Contrazip+import Contravariant.Extras.Prelude++contrazipLifting2 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> f (a1, a2)+contrazipLifting2 fn a b = contrazip2 (fn a) (fn b)++contrazipLifting3 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> f (a1, a2, a3)+contrazipLifting3 fn a b c = contrazip3 (fn a) (fn b) (fn c)++contrazipLifting4 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> f (a1, a2, a3, a4)+contrazipLifting4 fn a b c d = contrazip4 (fn a) (fn b) (fn c) (fn d)++contrazipLifting5 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> f (a1, a2, a3, a4, a5)+contrazipLifting5 fn a b c d e = contrazip5 (fn a) (fn b) (fn c) (fn d) (fn e)++contrazipLifting6 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> g a6 -> f (a1, a2, a3, a4, a5, a6)+contrazipLifting6 fn a b c d e f = contrazip6 (fn a) (fn b) (fn c) (fn d) (fn e) (fn f)++contrazipLifting7 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> g a6 -> g a7 -> f (a1, a2, a3, a4, a5, a6, a7)+contrazipLifting7 fn a b c d e f g = contrazip7 (fn a) (fn b) (fn c) (fn d) (fn e) (fn f) (fn g)++contrazipLifting8 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> g a6 -> g a7 -> g a8 -> f (a1, a2, a3, a4, a5, a6, a7, a8)+contrazipLifting8 fn a b c d e f g h = contrazip8 (fn a) (fn b) (fn c) (fn d) (fn e) (fn f) (fn g) (fn h)++contrazipLifting9 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> g a6 -> g a7 -> g a8 -> g a9 -> f (a1, a2, a3, a4, a5, a6, a7, a8, a9)+contrazipLifting9 fn a b c d e f g h i = contrazip9 (fn a) (fn b) (fn c) (fn d) (fn e) (fn f) (fn g) (fn h) (fn i)++contrazipLifting10 :: (Divisible f) => (forall x. g x -> f x) -> g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> g a6 -> g a7 -> g a8 -> g a9 -> g a10 -> f (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)+contrazipLifting10 fn a b c d e f g h i j = contrazip10 (fn a) (fn b) (fn c) (fn d) (fn e) (fn f) (fn g) (fn h) (fn i) (fn j)
library/Contravariant/Extras/Op.hs view
@@ -1,11 +1,10 @@ -- | -- This module exports functions specialized for the `Op` type. module Contravariant.Extras.Op-(- -- |- -- A berserk collection of @contrazip@ functions with arities of up to 42.- module Contravariant.Extras.Op.Contrazip,-)+ ( -- |+ -- A berserk collection of @contrazip@ functions with arities of up to 42.+ module Contravariant.Extras.Op.Contrazip,+ ) where import Contravariant.Extras.Op.Contrazip
library/Contravariant/Extras/Op/Contrazip.hs view
@@ -2,22 +2,19 @@ -- A berserk collection of @contrazip@ functions with arities of up to 42, -- which are specialized to the 'Op' type, -- and jump thru fewer hoops than their 'Divisible'-based siblings.--- +-- -- Why 42? -- Well, naturally, because it's the answer to the ultimate question of life, -- the universe and everything.--- +-- -- It's exported as a separate module from "Contravariant.Extras.Op" -- only to not pollute its documentation. -- The "Contravariant.Extras.Op" module still reexports this module, -- so you can simply import that only.--- module Contravariant.Extras.Op.Contrazip where -import BasePrelude+import Contravariant.Extras.Prelude import qualified Contravariant.Extras.TH as TH - -- Generate the @contrazip@ functions:-return (join (map (TH.opContrazipDecs "contrazip") (reverse [2..42])))-+return (join (map (TH.opContrazipDecs "contrazip") (reverse [2 .. 42])))
+ library/Contravariant/Extras/Prelude.hs view
@@ -0,0 +1,71 @@+module Contravariant.Extras.Prelude+ ( module Exports,+ )+where++import Control.Applicative as Exports+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports hiding (unzip)+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports+import Data.Functor.Identity as Exports+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (First (..), Last (..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Semigroup as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (alignment, sizeOf)+import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic, Generic1)+import GHC.IO.Exception as Exports+import Numeric as Exports+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe)+import Unsafe.Coerce as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))
library/Contravariant/Extras/TH.hs view
@@ -1,24 +1,25 @@-{-# LANGUAGE CPP #-}-module Contravariant.Extras.TH where--import BasePrelude-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Divisible-import Language.Haskell.TH hiding (classP)-import qualified TupleTH+module Contravariant.Extras.TH+ ( opContrazipDecs,+ contrazipDecs,+ contrazipExp,+ )+where +import Contravariant.Extras.Prelude+import Language.Haskell.TH.Syntax+import qualified TemplateHaskell.Compat.V0208 as Compat -- |--- Generates declarations like the following:--- +-- Generates declarations in the spirit of the following:+-- -- @ -- tuple3 :: Monoid a => Op a b1 -> Op a b2 -> Op a b3 -> Op a ( b1 , b2 , b3 ) -- tuple3 ( Op op1 ) ( Op op2 ) ( Op op3 ) = -- Op $ \( v1 , v2 , v3 ) -> mconcat [ op1 v1 , op2 v2 , op3 v3 ] -- @-opContrazipDecs :: String -> Int -> [ Dec ]+opContrazipDecs :: String -> Int -> [Dec] opContrazipDecs baseName arity =- [ signature , value ]+ [signature, value] where name = mkName (showString baseName (show arity))@@ -29,7 +30,7 @@ ForallT vars cxt type_ where vars =- map (PlainTV . mkName) ("a" : bs)+ map (Compat.specifiedPlainTV . mkName) ("a" : bs) where bs = map b (enumFromTo 1 arity)@@ -37,13 +38,13 @@ b index = showString "b" (show index) cxt =- [ pred ]+ [pred] where pred =- classP ''Monoid [ a ]+ Compat.classP ''Monoid [a] where a =- VarT (mkName "a") + VarT (mkName "a") type_ = foldr appArrowT result params where@@ -74,7 +75,7 @@ FunD name clauses where clauses =- [ clause ]+ [clause] where clause = Clause pats body []@@ -83,10 +84,10 @@ map pat (enumFromTo 1 arity) where pat index =- ConP 'Op pats+ Compat.conP 'Op pats where pats =- [ VarP name ]+ [VarP name] where name = mkName (showString "op" (show index))@@ -97,7 +98,7 @@ LamE pats exp where pats =- [ TupP pats ]+ [TupP pats] where pats = map pat (enumFromTo 1 arity)@@ -120,7 +121,7 @@ -- | -- Generates declarations in the spirit of the following:--- +-- -- @ -- contrazip4 :: Divisible f => f a1 -> f a2 -> f a3 -> f a4 -> f ( a1 , a2 , a3 , a4 ) -- contrazip4 f1 f2 f3 f4 =@@ -129,92 +130,76 @@ -- divide $(TupleTH.splitTupleAt 2 1) f3 $ -- f4 -- @-divisibleContrazipDecs :: String -> Int -> [Dec]-divisibleContrazipDecs baseName arity =- [signature, value]+contrazipDecs :: String -> Int -> [Dec]+contrazipDecs baseName arity = [signature, value] where- name =- mkName (showString baseName (show arity))- signature =- SigD name type_+ name = mkName (showString baseName (show arity))+ signature = SigD name (contrazipType arity)+ value = FunD name clauses where- type_ =- ForallT vars cxt type_+ clauses = [clause] where- fName =- mkName "f"- aNames =- map aName (enumFromTo 1 arity)- where- aName index =- mkName (showString "a" (show index))- vars =- map PlainTV (fName : aNames)- cxt =- [pred]- where- pred =- classP ''Divisible [VarT fName]- type_ =- foldr appArrowT result params+ clause = Clause [] body [] where- appArrowT a b =- AppT (AppT ArrowT a) b- result =- AppT (VarT fName) tuple- where- tuple =- foldl AppT (TupleT arity) (map VarT aNames)- params =- map param aNames- where- param aName =- AppT (VarT fName) (VarT aName)- value =- FunD name clauses+ body = NormalB (contrazipExp arity)++contrazipType :: Int -> Type+contrazipType arity = ForallT vars cxt type_+ where+ fName = mkName "f"+ aNames = map aName (enumFromTo 1 arity) where- clauses =- [clause]+ aName index = mkName (showString "a" (show index))+ vars = map Compat.specifiedPlainTV (fName : aNames)+ cxt = [pred]+ where+ pred = Compat.classP ''Divisible [VarT fName]+ type_ = foldr appArrowT result params+ where+ appArrowT a b = AppT (AppT ArrowT a) b+ result = AppT (VarT fName) tuple where- clause =- Clause pats body []- where- pats =- map pat (enumFromTo 1 arity)- where- pat index =- VarP name- where- name =- mkName (showString "f" (show index))- body =- NormalB (exp arity)- where- exp index =- case index of- 1 ->- VarE (mkName (showString "f" (show arity)))- _ ->- foldl1 AppE- [- VarE 'divide- ,- splitTupleAtE index 1- ,- VarE (mkName (showString "f" (show (arity - index + 1))))- ,- exp (pred index)- ]+ tuple = foldl AppT (TupleT arity) (map VarT aNames)+ params = map param aNames+ where+ param aName = AppT (VarT fName) (VarT aName) -splitTupleAtE :: Int -> Int -> Exp-splitTupleAtE arity position =- unsafePerformIO $- runQ $- TupleTH.splitTupleAt arity position+-- |+-- Contrazip lambda expression of specified arity.+--+-- Allows to create contrazip expressions of any arity:+--+-- >>>:t $(return (contrazipExp 2))+-- \$(return (contrazipExp 2))+-- :: Data.Functor.Contravariant.Divisible.Divisible f =>+-- f a1 -> f a2 -> f (a1, a2)+contrazipExp :: Int -> Exp+contrazipExp arity = SigE (LamE pats body) (contrazipType arity)+ where+ pats = map pat (enumFromTo 1 arity)+ where+ pat index = VarP name+ where+ name = mkName (showString "f" (show index))+ body = exp arity+ where+ exp index = case index of+ 1 -> VarE (mkName (showString "f" (show arity)))+ _ ->+ foldl1+ AppE+ [ VarE 'divide,+ splitTupleAtExp index 1,+ VarE (mkName (showString "f" (show (arity - index + 1)))),+ exp (pred index)+ ] -classP :: Name -> [Type] -> Pred-#if MIN_VERSION_template_haskell(2,10,0)-classP n tl = foldl AppT (ConT n) tl-#else-classP = ClassP-#endif+splitTupleAtExp :: Int -> Int -> Exp+splitTupleAtExp arity position =+ let nameByIndex index = Name (OccName ('_' : show index)) NameS+ names = enumFromTo 0 (pred arity) & map nameByIndex+ pats = names & map VarP+ pat = TupP pats+ exps = names & map VarE+ body = splitAt position exps & \(a, b) -> Compat.tupE [Compat.tupE a, Compat.tupE b]+ in LamE [pat] body