diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +18 Feb 2022 +0.5.2 Release +Remove custom Setup.lhs which was for ghc-7.6 + +Change to pun quasiquote improves error messages: + For `f [pun| x y |] = ()` + f :: _ => r (a ': b ': c) -> () -- old + f :: _ => r as -> () -- new +Previously if you supplied a 9 element record to a function +needing 10 elements, the error would not name the missing field. +It is possible but unlikely that the old code will need to a type +annotation like +(id :: HLengthGE x (HSucc (HSucc HZero)) => r x -> r x) + 23 Oct 2021 0.5.1 Release Build & pass tests with ghc-8.4.4 through 9.2.0.20210821, diff --git a/Data/HList/RecordPuns.hs b/Data/HList/RecordPuns.hs --- a/Data/HList/RecordPuns.hs +++ b/Data/HList/RecordPuns.hs @@ -118,33 +118,18 @@ suppressWarning f (V a) = f (C [V a]) suppressWarning f x = f x --- like \x -> (x .!. x1, x .!. x2) +-- extracts ["x1","x2"] becomes \x -> (x .!. x1, x .!. x2), +-- where x1 = Label :: Label "x1" extracts xs = do record <- newName "record" - let val = tupE + -- to fix #5 I could comment out the ensureLength below + lamE [varP record] $ tupE [ [| $(varE record) .!. $label |] | x <- xs, let label = [| Label :: Label $(litT (strTyLit x)) |], x /= "_" ] - -- constrain the type of the supplied record to have at least - -- as many elements as are extracted. In other words: - -- - -- > f :: r (e1 ': e2 ': e3 ': e4 ': es) -> () -- is inferred - -- > f [pun| { _ _ _ _ } |] = () - ensureLength = [| $(varE record) `asTypeOf` $(minLen xs) |] - - lamE [varP record] [| $val `const` $ensureLength |] - - --- | generates an @undefined :: r xs@, such that @xs :: [k]@ has --- at least as long as the input list -minLen :: [t] -> ExpQ -minLen [] = [| error "Data.HList.RecordPuns.minLen" :: r (es :: [*]) |] -minLen (_ : xs) = [| (error "Data.HList.RecordPuns.minLen" - :: r es -> r (e ': es)) $(minLen xs) |] - mkPair :: String -> ExpQ -> ExpQ mkPair x xe = [| (Label :: Label $(litT (strTyLit x))) .=. $xe |] @@ -174,7 +159,7 @@ mp (D as) = conP 'Record - [(foldr ( \ (n,p) xs -> conP 'HCons + [foldr ( \ (n,p) xs -> conP 'HCons [ let ty | n == "_" = [| undefined :: Tagged anyLabel t |] | otherwise = [| undefined :: Tagged $(litT (strTyLit n)) t |] @@ -182,7 +167,7 @@ (conP 'Tagged [p]), xs]) (conP 'HNil []) - (mps as))] + (mps as)] mp a = do reportWarning $ "Data.HList.RecordPuns.mp implicit {} added around:" ++ show a mp (C [a]) diff --git a/HList.cabal b/HList.cabal --- a/HList.cabal +++ b/HList.cabal @@ -1,5 +1,5 @@ Name: HList -Version: 0.5.1.0 +Version: 0.5.2.0 Category: Data Synopsis: Heterogeneous lists Description: HList provides many operations to create and manipulate @@ -30,7 +30,7 @@ Data-files: README, ChangeLog Cabal-version: >= 1.10 -Tested-With: GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.6, GHC==9.0.1, GHC==9.2.0.20210821 +Tested-With: GHC==8.10.7 Build-Type: Simple Extra-Source-Files: diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,114 +1,4 @@ -#!/usr/bin/runhaskell -\begin{code} -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -import Language.Haskell.Extension - ( Extension(EnableExtension, UnknownExtension, DisableExtension) ) -import Data.List ( nub ) -import Data.Version ( showVersion ) -import Distribution.Package - ( PackageName(PackageName), - PackageId, - InstalledPackageId, - packageVersion, - packageName ) -import Distribution.PackageDescription () -import Distribution.Simple - ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils - ( rewriteFile, createDirectoryIfMissingVerbose ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup () -import Distribution.Simple.LocalBuildInfo () -import System.FilePath ( () ) -import Distribution.Verbosity ( Verbosity ) -import Distribution.PackageDescription () -import Distribution.Simple.LocalBuildInfo () -import Distribution.PackageDescription - ( TestSuite(testName), - PackageDescription, - Library(libBuildInfo), - allExtensions ) -import Distribution.Simple.Compiler () -import Distribution.Simple.Setup - ( BuildFlags(buildVerbosity), - ConfigFlags(..), - Flag(Flag, NoFlag), - fromFlag ) -import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(configFlags), - ComponentLocalBuildInfo(componentPackageDeps), - withTestLBI, - withLibLBI ) -import Data.Maybe - -main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - } - -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule verbosity pkg lbi = do - let dir = autogenModulesDir lbi - createDirectoryIfMissingVerbose verbosity True dir - withLibLBI pkg lbi $ \ lib libcfg -> do - withTestLBI pkg lbi $ \suite suitecfg -> do - rewriteFile (dir "Build_" ++ testName suite ++ ".flags") $ unlines $ - [ hc , unwords (formatdeps (testDeps libcfg suitecfg) ++ exts lib) ] - where - hc = case configHcPath (configFlags lbi) of - Flag a -> a - NoFlag -> fromMaybe "ghc" (lookup "ghc" (configProgramPaths (configFlags lbi))) - formatdeps = map (formatone . snd) - formatone p = case packageName p of - PackageName n -> "-package=" ++ n ++ "-" ++ showVersion (packageVersion p) - - exts lib = [ "-X" ++ se - | e <- allExtensions (libBuildInfo lib), - Just se <- [case e of - EnableExtension x -> Just (show x) - UnknownExtension x -> Just x - DisableExtension x -> Just ("No" ++ show x) - ] - ] - -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys - - -\end{code} -Adapted from: - -Copyright 2012-2015 Edward Kmett - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - -2. 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. - -3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. +#!/usr/bin/env runhaskell -THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. +> import Distribution.Simple +> main = defaultMain diff --git a/examples/Properties/KW.hs b/examples/Properties/KW.hs --- a/examples/Properties/KW.hs +++ b/examples/Properties/KW.hs @@ -18,9 +18,6 @@ kwSpecs = describe "kw" $ do - -#if (__GLASGOW_HASKELL__ > 799) - return () {- with NoMonoLocalBinds - /home/aavogt/wip/HList/HList/examples/Properties/KW.hs:59:15: error:ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): @@ -77,7 +74,6 @@ f2 (ly .=. y2 .*. lx .=. x2 .*. emptyRecord) `eq` f1 x2 y2 -} -#else it "f1" $ property $ do (f1 :: BoolN "x" -> BoolN "y") <- arbitrary x :: BoolN "x" <- arbitrary @@ -126,4 +122,3 @@ f2 (ly .=. y2 .*. lx .=. x2 .*. emptyRecord) `eq` f1 x2 y2 ] -#endif