functor-infix 0.0.1 → 0.0.2

raw patch · 5 files changed

+69/−52 lines, 5 filesdep ~basedep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• functor-infix.cabal +4/−7
• src/Data/Functor/Infix.hs +3/−3
• src/Data/Functor/Infix/Definitions.hs +4/−4
• src/Data/Functor/Infix/TH.hs +58/−32
• src/Data/Functor/Infix/Utilities.hs +0/−6

@@ -1,7 +1,7 @@ name:   functor-infix version:-  0.0.1+  0.0.2 synopsis:   Compositions of functors. homepage:@@ -26,14 +26,11 @@     Data.Functor.Infix   other-modules:     Data.Functor.Infix.Definitions,-    Data.Functor.Infix.TH,-    Data.Functor.Infix.Utilities+    Data.Functor.Infix.TH   build-depends:-    base             == 4.*,-    template-haskell >= 2.8 && < 3.0+    base             >= 4.7 && < 4.9,+    template-haskell >= 2.8 && < 2.11   hs-source-dirs:     src   default-language:     Haskell2010-  ghc-options:-    -Wall -fno-warn-name-shadowing

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

@@ -2,8 +2,8 @@  module Data.Functor.Infix.Definitions where -import Data.Functor.Infix.TH (declareInfixFmapN, declareInfixPamfN)-import Data.Functor.Infix.Utilities (concatMapM)+import Control.Monad (msum)+import Data.Functor.Infix.TH (declareInfixFmapForFunctorCompositionOfDegree, declareFlippedInfixFmapForFunctorCompositionOfDegree) -$(concatMapM declareInfixFmapN [1..20])-$(concatMapM declareInfixPamfN [1..20])+$(fmap msum $ mapM declareInfixFmapForFunctorCompositionOfDegree [1..20])+$(fmap msum $ mapM declareFlippedInfixFmapForFunctorCompositionOfDegree [1..20])

@@ -1,44 +1,70 @@-{-# LANGUAGE TemplateHaskell  #-}-{-# LANGUAGE TupleSections    #-}+{-# LANGUAGE CPP             #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections   #-}+{-# LANGUAGE PatternSynonyms #-} -module Data.Functor.Infix.TH (-  declareInfixFmapN,-  declareInfixPamfN+module Data.Functor.Infix.TH+( declareInfixFmapForFunctorCompositionOfDegree+, declareFlippedInfixFmapForFunctorCompositionOfDegree+, declareInfixFmapN+, declareInfixPamfN ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), (<*>), pure) 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) '$'+(~>) :: Type -> Type -> Type+x ~> y = AppT ArrowT x `AppT` y+infixr 0 ~> -fmapExpN :: Int -> Q Exp-fmapExpN n = do-  (idt, fmp) <- (,) <$> [|id|] <*> [|fmap|]-  return $ foldr (AppE . AppE fmp) idt (replicate n fmp)+fmapTypeOfDegree :: Int -> Q Type+fmapTypeOfDegree n = do+  names@(a:b:fs) <- (mkName "a":) <$> (mkName "b":) <$> replicateM n (newName "f")+  let variables = map PlainTV names+#if MIN_VERSION_template_haskell(2,10,0)+      constraints = AppT (ConT $ mkName "Functor") . VarT <$> fs+#else+      constraints = map (ClassP (mkName "Functor") . pure . VarT) fs+#endif+      wrap hask = foldr AppT (VarT hask) $ map VarT fs+      type_ = (VarT a ~> VarT b) ~> wrap a ~> wrap b+  pure $ ForallT variables constraints type_ -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+fmapExpressionOfDegree :: Int -> Q Exp+fmapExpressionOfDegree n = do+  (id_, fmap_) <- (,) <$> [|id|] <*> [|fmap|]+  pure $ foldr (AppE . AppE fmap_) id_ (replicate n fmap_) -declareInfixPamfN :: Int -> Q [Dec]-declareInfixPamfN = declareInfixN pamfExpN pamfTypeN (Fixity 1 InfixL) '&'+declareInfixWithDegree :: (Int -> Q Exp) -> (Int -> Q Type) -> Fixity -> Char -> (Int -> Q [Dec])+declareInfixWithDegree expressionOfDegree typeOfDegree fixity symbol n = do+  let name = mkName $ "<" ++ replicate n symbol ++ ">"+  (expression, type_) <- (,) <$> expressionOfDegree n <*> typeOfDegree n+  pure $ SigD name type_+       : ValD (VarP name) (NormalB expression) []+       : InfixD fixity name+       : [] -pamfExpN :: Int -> Q Exp-pamfExpN n = [|flip|] >>= \flip -> AppE flip <$> fmapExpN n+declareInfixFmapForFunctorCompositionOfDegree :: Int -> Q [Dec]+declareInfixFmapForFunctorCompositionOfDegree = declareInfixWithDegree fmapExpressionOfDegree fmapTypeOfDegree (Fixity 4 InfixL) '$' -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))+pattern x :> y = AppT ArrowT x `AppT` 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]+(<$$>) :: Functor f => Functor g => (a -> b) -> f (g a) -> f (g b)+(<$$>) = fmap fmap fmap+infixl 1 <$$>++declareFlippedInfixFmapForFunctorCompositionOfDegree :: Int -> Q [Dec]+declareFlippedInfixFmapForFunctorCompositionOfDegree = do+  let flipExpression = AppE $ VarE (mkName "flip")+      flipType (ForallT variables constraints (a :> (b :> c))) = ForallT variables constraints (b ~> (a ~> c))+      flipType _ = error "The impossible happened!"+  declareInfixWithDegree (flipExpression <$$> fmapExpressionOfDegree) (flipType <$$> fmapTypeOfDegree) (Fixity 1 InfixL) '&'++{-# DEPRECATED declareInfixFmapN "Use 'declareInfixFmapForFunctorCompositionOfDegree' and/or reconsider your life choices." #-}+declareInfixFmapN :: Int -> Q [Dec]+declareInfixFmapN = declareInfixFmapForFunctorCompositionOfDegree++{-# DEPRECATED declareInfixPamfN "Use 'declareFlippedInfixFmapForFunctorCompositionOfDegree' and/or reconsider your life choices." #-}+declareInfixPamfN :: Int -> Q [Dec]+declareInfixPamfN = declareFlippedInfixFmapForFunctorCompositionOfDegree

@@ -1,6 +0,0 @@-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. ;-)