diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +# optics-th-0.4.1 (2022-03-22) +* Add support for GHC-9.2 + # optics-th-0.4 (2021-02-22) * Add support for GHC-9.0 * Print missing language extensions during TH generation of labels if there are diff --git a/optics-th.cabal b/optics-th.cabal --- a/optics-th.cabal +++ b/optics-th.cabal @@ -1,12 +1,13 @@ +cabal-version: 2.2 name: optics-th -version: 0.4 -license: BSD3 +version: 0.4.1 +license: BSD-3-Clause license-file: LICENSE build-type: Simple maintainer: optics@well-typed.com author: Andrzej Rybczak -cabal-version: 1.24 -tested-with: ghc ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.3, GHCJS ==8.4 +tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 + || ==9.0.2 || ==9.2.2, GHCJS ==8.4 synopsis: Optics construction using TemplateHaskell category: Data, Optics, Lenses description: @@ -24,16 +25,46 @@ location: https://github.com/well-typed/optics.git subdir: optics-th +common language + ghc-options: -Wall -Wcompat + + default-language: Haskell2010 + + default-extensions: BangPatterns + ConstraintKinds + DefaultSignatures + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyCase + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + KindSignatures + LambdaCase + OverloadedLabels + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + library - default-language: Haskell2010 + import: language hs-source-dirs: src - ghc-options: -Wall build-depends: base >= 4.10 && <5 , containers >= 0.5.10.2 && <0.7 , mtl >= 2.2.2 && <2.3 - , optics-core >= 0.4 && <0.5 - , template-haskell >= 2.12 && <2.18 + , optics-core >= 0.4.1 && <0.5 + , template-haskell >= 2.12 && <2.19 , th-abstraction >= 0.4 && <0.5 , transformers >= 0.5 && <0.6 @@ -47,9 +78,8 @@ other-modules: Language.Haskell.TH.Optics.Internal test-suite optics-th-tests - default-language: Haskell2010 + import: language hs-source-dirs: tests - ghc-options: -Wall build-depends: base , optics-core diff --git a/src/Language/Haskell/TH/Optics/Internal.hs b/src/Language/Haskell/TH/Optics/Internal.hs --- a/src/Language/Haskell/TH/Optics/Internal.hs +++ b/src/Language/Haskell/TH/Optics/Internal.hs @@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeSynonymInstances #-} module Language.Haskell.TH.Optics.Internal ( -- * Traversals @@ -16,7 +14,7 @@ , _OpenTypeFamilyD , _ForallT - -- * TyVarBndr compatiblity + -- * TyVarBndr compatibility , TyVarBndrSpec ) where diff --git a/src/Optics/TH.hs b/src/Optics/TH.hs --- a/src/Optics/TH.hs +++ b/src/Optics/TH.hs @@ -78,12 +78,12 @@ import Control.Monad.Trans.State import Control.Monad.Trans.Writer import Data.Char (toLower, toUpper, isUpper) -import Data.List as List import Data.Maybe (maybeToList) import Data.Monoid import Data.Set (Set) import Language.Haskell.TH.Syntax hiding (lift) import Language.Haskell.TH +import qualified Data.List as L import qualified Data.Set as Set import Optics.Core hiding (cons) @@ -206,7 +206,7 @@ emit =<< liftDeclare (makeFieldLabelsForDec rules dec) return $ stripFields dec --- | Rules for generation of 'LabelOptic' intances for use with +-- | Rules for generation of 'LabelOptic' instances for use with -- OverloadedLabels. Same as 'lensRules', but uses 'camelCaseNamer'. -- -- /Note:/ if you don't want to prefix field names with the full name of the @@ -799,8 +799,8 @@ return (MethodName (mkName cls) (mkName method)) where field' = nameBase field - prefix ('_':xs) | '_' `List.elem` xs = Just (takeWhile (/= '_') xs) - prefix _ = Nothing + prefix ('_':xs) | '_' `L.elem` xs = Just (takeWhile (/= '_') xs) + prefix _ = Nothing niceLens = prefix field' <&> \n -> drop (length n + 2) field' classNaming = niceLens <&> ("Has_" ++) @@ -808,7 +808,7 @@ camelCaseNamer :: FieldNamer camelCaseNamer tyName fields field = maybeToList $ do - fieldPart <- stripPrefix expectedPrefix (nameBase field) + fieldPart <- L.stripPrefix expectedPrefix (nameBase field) method <- computeMethod fieldPart let cls = "Has" ++ fieldPart return (MethodName (mkName cls) (mkName method)) @@ -816,7 +816,7 @@ where expectedPrefix = optUnderscore ++ over _head toLower (nameBase tyName) - optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] + optUnderscore = ['_' | any (L.isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing @@ -824,7 +824,7 @@ -- | A 'FieldNamer' for 'classUnderscoreNoPrefixFields'. classUnderscoreNoPrefixNamer :: FieldNamer classUnderscoreNoPrefixNamer _ _ field = maybeToList $ do - fieldUnprefixed <- stripPrefix "_" (nameBase field) + fieldUnprefixed <- L.stripPrefix "_" (nameBase field) let className = "Has" ++ over _head toUpper fieldUnprefixed methodName = fieldUnprefixed return (MethodName (mkName className) (mkName methodName)) @@ -839,11 +839,11 @@ return (MethodName (mkName cls) (mkName method)) where - stripMaxLc f = do x <- stripPrefix optUnderscore f + stripMaxLc f = do x <- L.stripPrefix optUnderscore f case break isUpper x of - (p,s) | List.null p || List.null s -> Nothing - | otherwise -> Just s - optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] + (p,s) | L.null p || L.null s -> Nothing + | otherwise -> Just s + optUnderscore = ['_' | any (L.isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing diff --git a/src/Optics/TH/Internal/Product.hs b/src/Optics/TH/Internal/Product.hs --- a/src/Optics/TH/Internal/Product.hs +++ b/src/Optics/TH/Internal/Product.hs @@ -1,10 +1,4 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskellQuotes #-} module Optics.TH.Internal.Product ( LensRules(..) @@ -22,9 +16,9 @@ import Control.Monad import Control.Monad.State import Data.Either -import Data.List import Data.Maybe import Language.Haskell.TH +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Traversable as T @@ -119,10 +113,10 @@ -- field name. See #323. stripSel :: String -> String stripSel n = fromMaybe n $ stripSuffix (':':first_con_name) - =<< stripPrefix "$sel:" n + =<< L.stripPrefix "$sel:" n stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] - stripSuffix suffix = fmap reverse . stripPrefix (reverse suffix) . reverse + stripSuffix suffix = fmap reverse . L.stripPrefix (reverse suffix) . reverse -- We have to look up the actual name of the first constructor, rather than -- trying to split the string on colons, because either the field name or @@ -301,7 +295,7 @@ scaffolds = [ (n, length ts, rightIndices ts) | (n,ts) <- consForDef ] rightIndices :: [Either Type Type] -> [Int] - rightIndices = findIndices (has _Right) + rightIndices = L.findIndices (has _Right) -- Right: types for this definition -- Left : other types diff --git a/src/Optics/TH/Internal/Sum.hs b/src/Optics/TH/Internal/Sum.hs --- a/src/Optics/TH/Internal/Sum.hs +++ b/src/Optics/TH/Internal/Sum.hs @@ -7,11 +7,11 @@ ) where import Data.Char -import Data.List import Data.Maybe import Data.Traversable import Language.Haskell.TH import Language.Haskell.TH.Datatype.TyVarBndr +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S import qualified Language.Haskell.TH.Datatype as D @@ -231,7 +231,7 @@ computeOpticType :: StabConfig -> Type -> [NCon] -> NCon -> Q Stab computeOpticType conf t cons con = - do let cons' = delete con cons + do let cons' = L.delete con cons if null (_nconVars con) then computePrismType conf t (view nconCxt con) cons' con else computeReviewType t (view nconCxt con) (view nconTypes con) @@ -478,7 +478,7 @@ instance HasTypeVars NCon where typeVarsEx s = traversalVL $ \f (NCon x vars y z) -> - let s' = foldl' (flip S.insert) s vars + let s' = L.foldl' (flip S.insert) s vars in NCon x vars <$> traverseOf (typeVarsEx s') f y <*> traverseOf (typeVarsEx s') f z diff --git a/src/Optics/TH/Internal/Utils.hs b/src/Optics/TH/Internal/Utils.hs --- a/src/Optics/TH/Internal/Utils.hs +++ b/src/Optics/TH/Internal/Utils.hs @@ -2,9 +2,9 @@ import Control.Monad import Data.Maybe -import Data.List import Language.Haskell.TH import Language.Haskell.TH.Datatype.TyVarBndr +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S import qualified Language.Haskell.TH.Datatype as D @@ -125,9 +125,9 @@ ] extensions -> fail $ mconcat [ "Generating " ++ what ++ " requires the following language extensions:\n\n" - , intercalate "\n" (map (("- " ++) . show) extensions) + , L.intercalate "\n" (map (("- " ++) . show) extensions) , "\n\nPlease enable the extensions by copy/pasting these lines into the top of your file:\n\n" - , intercalate "\n" (map extensionToPragma extensions) + , L.intercalate "\n" (map extensionToPragma extensions) , "\n\nTo enable them in a GHCi session, use the following command:\n\n" , ":seti " ++ unwords (map (("-X" ++) . show) extensions) ] diff --git a/tests/Optics/TH/Tests.hs b/tests/Optics/TH/Tests.hs --- a/tests/Optics/TH/Tests.hs +++ b/tests/Optics/TH/Tests.hs @@ -1,16 +1,8 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeInType #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- {-# OPTIONS_GHC -ddump-splices #-} module Main where diff --git a/tests/Optics/TH/Tests/DuplicateRecordFields.hs b/tests/Optics/TH/Tests/DuplicateRecordFields.hs --- a/tests/Optics/TH/Tests/DuplicateRecordFields.hs +++ b/tests/Optics/TH/Tests/DuplicateRecordFields.hs @@ -1,11 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | Test that 'declareFieldLabels' and 'declareLenses' work in the presence of -- @DuplicateRecordFields@ (see issue #323), including when the data constructor diff --git a/tests/Optics/TH/Tests/T799.hs b/tests/Optics/TH/Tests/T799.hs --- a/tests/Optics/TH/Tests/T799.hs +++ b/tests/Optics/TH/Tests/T799.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -- | Test 'makeFields' on a field whose type has a data family. Unlike for type -- families, for data families we do not generate type equality constraints, as -- they are not needed to avoid the issue in #754.