syb 0.7.2.1 → 0.7.2.2
raw patch · 36 files changed
+108/−79 lines, 36 files
Files
- ChangeLog +8/−0
- syb.cabal +1/−1
- tests/Bits.hs +3/−3
- tests/Builders.hs +0/−2
- tests/CompanyDatatypes.hs +1/−1
- tests/Datatype.hs +11/−8
- tests/Encode.hs +6/−6
- tests/Ext.hs +3/−5
- tests/Ext1.hs +3/−2
- tests/FreeNames.hs +1/−1
- tests/GEq.hs +1/−1
- tests/GMapQAssoc.hs +2/−1
- tests/GRead.hs +1/−1
- tests/GRead2.hs +5/−4
- tests/GShow.hs +1/−1
- tests/GShow2.hs +1/−1
- tests/GZip.hs +2/−1
- tests/GenUpTo.hs +1/−1
- tests/GetC.hs +16/−5
- tests/HList.hs +1/−1
- tests/HOPat.hs +2/−1
- tests/Labels.hs +1/−1
- tests/LocalQuantors.hs +3/−2
- tests/NestedDatatypes.hs +4/−3
- tests/Newtype.hs +2/−2
- tests/Paradise.hs +0/−2
- tests/Perm.hs +5/−3
- tests/Polymatch.hs +5/−4
- tests/Reify.hs +5/−2
- tests/Strings.hs +0/−2
- tests/Tree.hs +4/−4
- tests/Twin.hs +2/−1
- tests/Typecase1.hs +1/−1
- tests/Typecase2.hs +1/−1
- tests/Where.hs +1/−1
- tests/XML.hs +4/−3
ChangeLog view
@@ -1,3 +1,11 @@+2022-09-17 Sergey Vinokurov <serg.foo@gmail.com>++ * 0.7.2.2: Compatibility with GHC 9.4++2021-01-20 Sergey Vinokurov <serg.foo@gmail.com>++ * 0.7.2.1: Update cabal version+ 2021-01-18 Sergey Vinokurov <serg.foo@gmail.com> * 0.7.2: Add compatibility with GHC 9, switch to tasty for tests,
syb.cabal view
@@ -1,5 +1,5 @@ name: syb-version: 0.7.2.1+version: 0.7.2.2 license: BSD3 license-file: LICENSE author: Ralf Lammel, Simon Peyton Jones, Jose Pedro Magalhaes
tests/Bits.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module Bits (tests) where @@ -134,7 +134,7 @@ fmap = liftM instance Applicative ReadB where- pure = return+ pure a = ReadB (\bs -> (Just a, bs)) (<*>) = ap instance Alternative ReadB where@@ -143,7 +143,7 @@ -- It's a monad. instance Monad ReadB where- return a = ReadB (\bs -> (Just a, bs))+ return = pure (ReadB c) >>= f = ReadB (\bs -> case c bs of (Just a, bs') -> unReadB (f a) bs' (Nothing, bs') -> (Nothing, bs')
tests/Builders.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fglasgow-exts #-}- module Builders (tests) where -- Testing Data.Generics.Builders functionality
tests/CompanyDatatypes.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module CompanyDatatypes where
tests/Datatype.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} -- These are simple tests to observe (data)type representations. module Datatype where@@ -34,22 +34,25 @@ )))))) @?= output -#if __GLASGOW_HASKELL__ >= 709+# if __GLASGOW_HASKELL__ >= 904+-- In GHC 9.4 module name is included+output = "(MyDataType Int,(DataType {tycon = \"Datatype.MyDataType\", datarep = AlgRep [MyDataType]},(\"\",(\"MyDataType\",(\"Datatype\",\"MyDataType\")))))"+# elif __GLASGOW_HASKELL__ >= 709 -- In GHC 7.10 module name is stripped from DataType output = "(MyDataType Int,(DataType {tycon = \"MyDataType\", datarep = AlgRep [MyDataType]},(\"\",(\"MyDataType\",(\"\",\"MyDataType\")))))"-#else+# else output = "(MyDataType Int,(DataType {tycon = \"Datatype.MyDataType\", datarep = AlgRep [MyDataType]},(\"\",(\"MyDataType\",(\"Datatype\",\"MyDataType\")))))"-#endif+# endif #else tests = show ( myTypeRep, myDataType ) @?= output -#if __GLASGOW_HASKELL__ >= 701+# if __GLASGOW_HASKELL__ >= 701 output = "(MyDataType Int,DataType {tycon = \"Datatype.MyDataType\", datarep = AlgRep [MyDataType]})"-#else+# else output = "(Datatype.MyDataType Int,DataType {tycon = \"Datatype.MyDataType\", datarep = AlgRep [MyDataType]})"-#endif+# endif #endif
tests/Encode.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyDataDecls #-} -- A bit more test code for the 2nd boilerplate paper. -- These are downscaled versions of library functionality or real test cases.@@ -67,11 +68,10 @@ instance Functor EncM where fmap = liftM instance Applicative EncM where- pure = return+ pure = undefined (<*>) = ap-instance Monad EncM- where- return = undefined+instance Monad EncM where+ return = pure c >>= f = undefined runEnc :: EncM () -> [Bit]@@ -84,5 +84,5 @@ data2bits'' t = runEnc (emit t) emit :: Data a => a -> EncM ()-emit t = do { emitCon (dataTypeOf t) (toConstr t) +emit t = do { emitCon (dataTypeOf t) (toConstr t) ; sequence_ (gmapQ emit t) }
tests/Ext.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fglasgow-exts #-}- module Ext () where -- There were typos in these definitions in the ICFP 2004 paper.@@ -10,14 +8,14 @@ = case gcast (Q spec_fn) of Just (Q spec_fn') -> spec_fn' arg Nothing -> fn arg- + newtype Q r a = Q (a -> r)- + extT fn spec_fn arg = case gcast (T spec_fn) of Just (T spec_fn') -> spec_fn' arg Nothing -> fn arg- + newtype T a = T (a -> a) extM :: (Typeable a, Typeable b)
tests/Ext1.hs view
@@ -1,5 +1,6 @@-{-# OPTIONS -fglasgow-exts #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-} module Ext1 (tests) where
tests/FreeNames.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module FreeNames (tests) where
tests/GEq.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module GEq (tests) where
tests/GMapQAssoc.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-} module GMapQAssoc (tests) where
tests/GRead.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module GRead (tests) where
tests/GRead2.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-} module GRead2 () where @@ -24,17 +25,17 @@ fmap = liftM instance Applicative DecM where- pure = return+ pure a = D (\s -> Just (s,a)) (<*>) = ap instance Monad DecM where- return a = D (\s -> Just (s,a))+ return = pure (D m) >>= k = D (\s -> case m s of Nothing -> Nothing Just (s1,a) -> let D n = k a in n s1)- + runDec :: String -> DecM a -> Maybe a runDec input (D m) = do (_,x) <- m input return x
tests/GShow.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module GShow (tests) where
tests/GShow2.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module GShow2 (tests) where
tests/GZip.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-} module GZip (tests) where
tests/GenUpTo.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module GenUpTo (tests) where
tests/GetC.hs view
@@ -1,6 +1,17 @@-{-# OPTIONS -fglasgow-exts #-}-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-}+# if __GLASGOW_HASKELL__ <= 708+{-# LANGUAGE OverlappingInstances #-}+#endif+ module GetC (tests) where import Test.Tasty.HUnit@@ -73,8 +84,8 @@ -- class GetT f t | f -> t -- FD is optional-instance GetT g t => GetT (x -> g) t-instance TypeUnify t t' => GetT t t'+instance GetT g t => GetT (x -> g) t+instance {-# OVERLAPPABLE #-} TypeUnify t t' => GetT t t' --@@ -94,7 +105,7 @@ (x::x) <- unExTypeable h getC (f x) t -instance Data t => GetC t+instance {-# OVERLAPPABLE #-} Data t => GetC t where getC y [] = Just $ toConstr y getC _ (_:_) = Nothing
tests/HList.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE ExistentialQuantification #-} module HList (tests) where
tests/HOPat.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExplicitForAll #-} module HOPat (tests) where
tests/Labels.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module Labels (tests) where
tests/LocalQuantors.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-} module LocalQuantors () where @@ -12,7 +13,7 @@ instance Data Test where- gfoldl _ z x = z x -- folding without descent + gfoldl _ z x = z x -- folding without descent toConstr (Test _) = testConstr gunfold _ _ = error "gunfold" dataTypeOf _ = testDataType
tests/NestedDatatypes.hs view
@@ -1,6 +1,7 @@-{-# OPTIONS -fglasgow-exts #-}-{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE UndecidableInstances #-} module NestedDatatypes () where @@ -19,7 +20,7 @@ import Data.Dynamic import Data.Generics - + -- A nested datatype data Nest a = Box a | Wrap (Nest [a]) deriving Typeable
tests/Newtype.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} module Newtype (tests) where
tests/Paradise.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fglasgow-exts #-}- module Paradise (tests) where {-
tests/Perm.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} module Perm (tests) where @@ -49,7 +51,7 @@ fmap = liftM instance Applicative ReadT where- pure = return+ pure x = ReadT (\y -> Just (y,x)) (<*>) = ap instance Alternative ReadT where@@ -58,7 +60,7 @@ -- ReadT is a monad! instance Monad ReadT where- return x = ReadT (\y -> Just (y,x))+ return = pure c >>= f = ReadT (\x -> case unReadT c x of Nothing -> Nothing Just (x', a) -> unReadT (f a) x'
tests/Polymatch.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-} module Polymatch () where @@ -13,7 +14,7 @@ data Kid = forall k. Typeable k => Kid k --- Build term from a list of kids and the constructor +-- Build term from a list of kids and the constructor fromConstrL :: Data a => Kids -> Constr -> Maybe a fromConstrL l = unIDL . gunfold k z where@@ -42,7 +43,7 @@ f g (Right a) = Right $ g a -- conversion really needed -- f g (Left s) = Left s -- unappreciated conversion--- f g s = s -- doesn't typecheck +-- f g s = s -- doesn't typecheck -- f g s = deep_rebuild s -- too expensive f g s = just (shallow_rebuild s) -- perhaps this is Ok? @@ -58,7 +59,7 @@ -- For the record: it's possible. shallow_rebuild :: (Data a, Data b) => a -> Maybe b-shallow_rebuild a = b +shallow_rebuild a = b where b = fromConstrL (kids a) constr constr = indexConstr (dataTypeOf b) (constrIndex (toConstr a))
tests/Reify.hs view
@@ -1,5 +1,8 @@-{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Reify (tests) where {-@@ -92,7 +95,7 @@ -- Generic type functions, -- i.e., functions mapping types to values ---type GTypeFun r = forall a. Data a => TypeFun a r+type GTypeFun r = forall a. Data a => TypeFun a r
tests/Strings.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fglasgow-exts #-}- module Strings (tests) where {-
tests/Tree.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE ScopedTypeVariables #-} module Tree (tests) where @@ -34,13 +34,13 @@ gdefault (Node x ts) = res where - -- a helper for type capture+ -- a helper for type capture res = maybe Nothing (kids . fromConstr) con - -- the type to constructed+ -- the type to constructed ta = fromJust res - -- construct constructor+ -- construct constructor con = readConstr (dataTypeOf ta) x -- recursion per kid with accumulation
tests/Twin.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-} module Twin (tests) where
tests/Typecase1.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module Typecase1 (tests) where
tests/Typecase2.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module Typecase2 (tests) where
tests/Where.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-} module Where (tests) where
tests/XML.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-} module XML (tests) where @@ -162,7 +163,7 @@ fmap = liftM instance Applicative ReadX where- pure = return+ pure x = ReadX (\y -> Just (y,x)) (<*>) = ap instance Alternative ReadX where@@ -171,7 +172,7 @@ -- ReadX is a monad! instance Monad ReadX where- return x = ReadX (\y -> Just (y,x))+ return = pure c >>= f = ReadX (\x -> case unReadX c x of Nothing -> Nothing Just (x', a) -> unReadX (f a) x'