optics-th 0.4 → 0.4.1
raw patch · 10 files changed
+65/−57 lines, 10 filesdep ~containersdep ~mtldep ~optics-corePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: containers, mtl, optics-core, template-haskell, th-abstraction, transformers
API changes (from Hackage documentation)
Files
- CHANGELOG.md +3/−0
- optics-th.cabal +40/−10
- src/Language/Haskell/TH/Optics/Internal.hs +1/−3
- src/Optics/TH.hs +11/−11
- src/Optics/TH/Internal/Product.hs +4/−10
- src/Optics/TH/Internal/Sum.hs +3/−3
- src/Optics/TH/Internal/Utils.hs +3/−3
- tests/Optics/TH/Tests.hs +0/−8
- tests/Optics/TH/Tests/DuplicateRecordFields.hs +0/−5
- tests/Optics/TH/Tests/T799.hs +0/−4
CHANGELOG.md view
@@ -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
optics-th.cabal view
@@ -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
src/Language/Haskell/TH/Optics/Internal.hs view
@@ -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
src/Optics/TH.hs view
@@ -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
src/Optics/TH/Internal/Product.hs view
@@ -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
src/Optics/TH/Internal/Sum.hs view
@@ -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
src/Optics/TH/Internal/Utils.hs view
@@ -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) ]
tests/Optics/TH/Tests.hs view
@@ -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
tests/Optics/TH/Tests/DuplicateRecordFields.hs view
@@ -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
tests/Optics/TH/Tests/T799.hs view
@@ -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.