autoapply 0.4.1 → 0.4.1.1
raw patch · 6 files changed
+136/−57 lines, 6 filesdep ~th-desugarPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: th-desugar
API changes (from Hackage documentation)
Files
- autoapply.cabal +39/−6
- changelog.md +3/−0
- default.nix +13/−38
- package.yaml +62/−0
- src/AutoApply.hs +16/−10
- test/Types.hs +3/−3
autoapply.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.24 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: adce22696e9593f56e72a791f5f8ef22dcc139f9909ff91a4034795112ed4ed2+-- hash: 8ee53363c7e4d90277a3ca258c64ba2e7a9cb984cd139b5f7cfdd9d0f664bb2a name: autoapply-version: 0.4.1+version: 0.4.1.1 synopsis: Template Haskell to automatically pass values to functions description: See readme.md category: Template Haskell@@ -22,6 +22,7 @@ readme.md default.nix changelog.md+ package.yaml source-repository head type: git@@ -40,14 +41,30 @@ Paths_autoapply hs-source-dirs: src- default-extensions: DeriveFoldable DeriveFunctor DeriveTraversable DerivingStrategies FlexibleContexts KindSignatures LambdaCase PatternSynonyms RankNTypes RecordWildCards ScopedTypeVariables TemplateHaskellQuotes TupleSections TypeApplications TypeFamilies ViewPatterns+ default-extensions:+ DeriveFoldable+ DeriveFunctor+ DeriveTraversable+ DerivingStrategies+ FlexibleContexts+ KindSignatures+ LambdaCase+ PatternSynonyms+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TemplateHaskellQuotes+ TupleSections+ TypeApplications+ TypeFamilies+ ViewPatterns ghc-options: -Wall build-depends: base >=4.12 && <5 , logict , mtl , template-haskell- , th-desugar >=1.11 && <1.12+ , th-desugar ==1.12.* , transformers , unification-fd default-language: Haskell2010@@ -59,7 +76,23 @@ Types hs-source-dirs: test- default-extensions: DeriveFoldable DeriveFunctor DeriveTraversable DerivingStrategies FlexibleContexts KindSignatures LambdaCase PatternSynonyms RankNTypes RecordWildCards ScopedTypeVariables TemplateHaskellQuotes TupleSections TypeApplications TypeFamilies ViewPatterns+ default-extensions:+ DeriveFoldable+ DeriveFunctor+ DeriveTraversable+ DerivingStrategies+ FlexibleContexts+ KindSignatures+ LambdaCase+ PatternSynonyms+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TemplateHaskellQuotes+ TupleSections+ TypeApplications+ TypeFamilies+ ViewPatterns ghc-options: -Wall build-depends: autoapply
changelog.md view
@@ -2,6 +2,9 @@ ## WIP +## [0.4.1.1] - 2021-10-17+ - Bump th-desugar version+ ## [0.4.1] - 2020-08-26 - Fix tests in dist
default.nix view
@@ -1,42 +1,17 @@-{ pkgs ? import <nixpkgs> { }, compiler ? "ghc884", hoogle ? true }:+{ pkgs ? import ./nixpkgs.nix, compiler ? null+, extraOverrides ? _: _: { }, modifier ? x: x }: let- src = pkgs.nix-gitignore.gitignoreSource [ ] ./.;-- compiler' = if compiler != null then- compiler+ haskellPackages = if compiler == null then+ pkgs.haskellPackages else- "ghc" + pkgs.lib.concatStrings- (pkgs.lib.splitVersion pkgs.haskellPackages.ghc.version);-- # Any overrides we require to the specified haskell package set- haskellPackages = with pkgs.haskell.lib;- pkgs.haskell.packages.${compiler'}.override {- overrides = self: super:- {- th-desugar = self.th-desugar_1_11;- } // pkgs.lib.optionalAttrs hoogle {- ghc = super.ghc // { withPackages = super.ghc.withHoogle; };- ghcWithPackages = self.ghc.withPackages;- };- };-- # Any packages to appear in the environment provisioned by nix-shell- extraEnvPackages = with haskellPackages; [ ];-- # Generate a haskell derivation using the cabal2nix tool on `package.yaml`- drv = let old = haskellPackages.callCabal2nix "" src { };- in old // {- # Insert the extra environment packages into the environment generated by- # cabal2nix- env = pkgs.lib.overrideDerivation old.env (attrs:- {- buildInputs = attrs.buildInputs ++ extraEnvPackages;- } // pkgs.lib.optionalAttrs hoogle {- shellHook = attrs.shellHook + ''- export HIE_HOOGLE_DATABASE="$(cat $(${pkgs.which}/bin/which hoogle) | sed -n -e 's|.*--database \(.*\.hoo\).*|\1|p')"- '';- });- };+ pkgs.haskell.packages.${compiler}; -in if pkgs.lib.inNixShell then drv.env else drv+in haskellPackages.developPackage {+ name = "";+ root = pkgs.nix-gitignore.gitignoreSource [ ] ./.;+ overrides = with pkgs.haskell.lib;+ pkgs.lib.composeExtensions+ (self: _super: { th-desugar = self.th-desugar_1_12; }) extraOverrides;+ inherit modifier;+}
+ package.yaml view
@@ -0,0 +1,62 @@+name: autoapply+version: "0.4.1.1"+synopsis: Template Haskell to automatically pass values to functions+description: See readme.md+category: Template Haskell+maintainer: Joe Hermaszewski <if.it.fits.i.sits@monoid.al>+copyright: (c) 2020 Joe Hermaszewski+github: expipiplus1/autoapply+extra-source-files:+ - readme.md+ - default.nix+ - changelog.md+ - package.yaml++library:+ source-dirs: src+ dependencies:+ - base >= 4.12 && < 5+ - logict+ - mtl+ - template-haskell+ - th-desugar >= 1.12 && < 1.13+ - transformers+ - unification-fd++tests:+ doctests:+ main: Doctests.hs+ other-modules: Types+ source-dirs:+ - test+ dependencies:+ - base+ - doctest+ - autoapply++custom-setup:+ dependencies:+ - base+ - Cabal+ - cabal-doctest >= 1 && <1.1++ghc-options:+ - -Wall++default-extensions:+ - DeriveFoldable+ - DeriveFunctor+ - DeriveTraversable+ - DerivingStrategies+ - FlexibleContexts+ - KindSignatures+ - LambdaCase+ - PatternSynonyms+ - RankNTypes+ - RecordWildCards+ - ScopedTypeVariables+ - TemplateHaskellQuotes+ - TupleSections+ - TypeApplications+ - TypeFamilies+ - ViewPatterns
src/AutoApply.hs view
@@ -260,7 +260,7 @@ BoundPure _ (Given _ n _) -> DVarE n Argument n _ -> DVarE n )- exp' <- dsDoStmts (bs <> [NoBindS (sweeten ret')])+ exp' <- dsDoStmts Nothing (bs <> [NoBindS (sweeten ret')]) -- Typing the arguments here is important, if we don't then some skolems -- might escape!@@ -336,20 +336,20 @@ ArrowF -> DArrowT LitF l -> DLitT l -varBndrName :: DTyVarBndr -> Name+varBndrName :: DTyVarBndrUnit -> Name varBndrName = \case- DPlainTV n -> n- DKindedTV n _ -> n+ DPlainTV n () -> n+ DKindedTV n () _ -> n -- | Raise foralls on the spine of the function type to the top -- -- For example @forall a. a -> forall b. b@ becomes @forall a b. a -> b@ raiseForalls :: DType -> DType raiseForalls = go >>> \case- (vs, ctx, t) -> DForallT ForallVis vs . DConstrainedT ctx $ t+ (vs, ctx, t) -> DForallT (DForallVis vs) . DConstrainedT ctx $ t where go = \case- DForallT _ vs t -> let (vs', ctx', t') = go t in (vs <> vs', ctx', t')+ DForallT vs t -> let (vs', ctx', t') = go t in (telescopeBndrs vs <> vs', ctx', t') DConstrainedT ctx t -> let (vs', ctx', t') = go t in (vs', ctx <> ctx', t') l :~> r -> let (vs, ctx, r') = go r in (vs, ctx, l :~> r')@@ -391,20 +391,26 @@ stripForall :: DType -> ([Name], DType) stripForall = raiseForalls >>> \case- DForallT _ vs (DConstrainedT _ ty) -> (varBndrName <$> vs, ty)- DForallT _ vs ty -> (varBndrName <$> vs, ty)+ DForallT vs (DConstrainedT _ ty) -> (varBndrName <$> telescopeBndrs vs, ty)+ DForallT vs ty -> (varBndrName <$> telescopeBndrs vs, ty) DConstrainedT _ ty -> ([], ty) ty -> ([], ty) -unravel :: DType -> ([DTyVarBndr], [DPred], [DType], DType)+telescopeBndrs :: DForallTelescope -> [DTyVarBndrUnit]+telescopeBndrs = \case+ DForallVis vs -> vs+ DForallInvis vs -> (() <$) <$> vs++unravel :: DType -> ([DTyVarBndrUnit], [DPred], [DType], DType) unravel t = let (argList, ret) = unravelDType t go = \case DFANil -> ([], [], [])- DFAForalls _ vs as -> (vs, [], []) <> go as+ DFAForalls vs as -> (telescopeBndrs vs, [], []) <> go as DFACxt preds as -> ([], preds, []) <> go as DFAAnon a as -> ([], [], [a]) <> go as in let (vs, preds, args) = go argList in (vs, preds, args, ret) note :: MonadFail m => String -> Maybe a -> m a note s = maybe (fail s) pure+
test/Types.hs view
@@ -131,7 +131,7 @@ -- >>> :t x -- x :: () test6 :: (forall a b. a -> b) -> ()-test6 = const ()+test6 = \x -> const () x autoapplyDecs (<> "'") [] ['id] ['test6] test6' :: (forall a b. a -> b) -> () @@ -141,7 +141,7 @@ -- >>> :t x -- x :: (forall a. a) -> () test7 :: (forall a. a) -> ()-test7 = const ()+test7 = \x -> const () x -- | 'id' is instantiated twice at different types -- >>> $(autoapply [] ['id] 'test8)@@ -313,7 +313,7 @@ -- -- >>> x = $(autoapply [] [] 'test23) -- <BLANKLINE>--- <interactive>:355:7: error:+-- <interactive>:...: error: -- • "Impossible" Finding argument provenances failed (unless the function context containts a class with no instances) -- • In the untyped splice: $(autoapply [] [] 'test23) class MyClassWithNoInstances (a :: Type) where