functor-infix (empty) → 0.0.1

raw patch · 7 files changed

+127/−0 lines, 7 filesdep +basedep +template-haskellsetup-changed

Dependencies added: base, template-haskell

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• functor-infix.cabal +39/−0
• src/Data/Functor/Infix.hs +7/−0
• src/Data/Functor/Infix/Definitions.hs +9/−0
• src/Data/Functor/Infix/TH.hs +44/−0
• src/Data/Functor/Infix/Utilities.hs +6/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 vi++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.

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

@@ -0,0 +1,39 @@+name:+  functor-infix+version:+  0.0.1+synopsis:+  Compositions of functors.+homepage:+  https://github.com/fmap/functor-infix+license:+  MIT+license-file:+  LICENSE+author:+  vi+maintainer:+  vi@zalora.com+category:+  Data+build-type:+  Simple+cabal-version:+  >= 1.10++library+  exposed-modules:+    Data.Functor.Infix+  other-modules:+    Data.Functor.Infix.Definitions,+    Data.Functor.Infix.TH,+    Data.Functor.Infix.Utilities+  build-depends:+    base             == 4.*,+    template-haskell >= 2.8 && < 3.0+  hs-source-dirs:+    src+  default-language:+    Haskell2010+  ghc-options:+    -Wall -fno-warn-name-shadowing

@@ -0,0 +1,7 @@+module Data.Functor.Infix (+  module Data.Functor.Infix.TH,+  module Data.Functor.Infix.Definitions+) where+  +import Data.Functor.Infix.TH+import Data.Functor.Infix.Definitions

@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}++module Data.Functor.Infix.Definitions where++import Data.Functor.Infix.TH (declareInfixFmapN, declareInfixPamfN)+import Data.Functor.Infix.Utilities (concatMapM)++$(concatMapM declareInfixFmapN [1..20])+$(concatMapM declareInfixPamfN [1..20])

@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE TupleSections    #-}++module Data.Functor.Infix.TH (+  declareInfixFmapN,+  declareInfixPamfN+) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (replicateM)+import Language.Haskell.TH (Q, Exp(..), Type(..), Dec(..), Pat(..), TyVarBndr(..), Pred(..), Body(..), newName, mkName, Fixity(..), FixityDirection(..))++declareInfixFmapN :: Int -> Q [Dec]+declareInfixFmapN = declareInfixN fmapExpN fmapTypeN (Fixity 4 InfixL) '$'++fmapExpN :: Int -> Q Exp+fmapExpN n = do+  (idt, fmp) <- (,) <$> [|id|] <*> [|fmap|]+  return $ foldr (AppE . AppE fmp) idt (replicate n fmp)++fmapTypeN :: Int -> Q Type+fmapTypeN n = do+  (varsAB, varsFu) <- ([mkName "a", mkName "b"],) <$> replicateM n (newName "f")+  let vrs = PlainTV <$> varsAB ++ varsFu+      cns = ClassP (mkName "Functor") . return . VarT <$> varsFu+      wrp = \n -> foldr AppT (VarT n) $ VarT <$> varsFu+      typ = AppT (AppT ArrowT (AppT (AppT ArrowT (VarT $ varsAB!!0)) (VarT $ varsAB!!1))) (AppT (AppT ArrowT . wrp $ varsAB!!0) (wrp $ varsAB!!1))+  return $ ForallT vrs cns typ++declareInfixPamfN :: Int -> Q [Dec]+declareInfixPamfN = declareInfixN pamfExpN pamfTypeN (Fixity 1 InfixL) '&'++pamfExpN :: Int -> Q Exp+pamfExpN n = [|flip|] >>= \flip -> AppE flip <$> fmapExpN n++pamfTypeN :: Int -> Q Type+pamfTypeN n = fmapTypeN n >>= \(ForallT crs wrp (AppT (AppT ArrowT ab) (AppT (AppT ArrowT x) y))) ->+  return $ ForallT crs wrp (AppT (AppT ArrowT x) (AppT (AppT ArrowT ab) y))++declareInfixN :: (Int -> Q Exp) -> (Int -> Q Type) -> Fixity -> Char -> Int -> Q [Dec]+declareInfixN expN typN fixity chr n = do+  let name = mkName $ "<" ++ replicate n chr ++ ">"+  (exp, typ) <- (,) <$> expN n <*> typN n+  return [SigD name typ, ValD (VarP name) (NormalB exp) [], InfixD fixity name]

@@ -0,0 +1,6 @@+module Data.Functor.Infix.Utilities (concatMapM) where++import Data.Monoid (Monoid(mconcat))++concatMapM :: Functor m => Monad m => Monoid b => (a -> m b) -> [a] -> m b+concatMapM = fmap (fmap mconcat) `fmap` mapM -- It'd be really convenient to have <$$$> here. ;-)