From b1086c542b8756786eea7f47a42d6277b7756c84 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Tue, 23 Apr 2024 13:57:01 +0200 Subject: [PATCH 1/4] support ghc98: relax bounds on upgradable packages --- dhall-csv/dhall-csv.cabal | 2 +- dhall-json/dhall-json.cabal | 2 +- dhall-lsp-server/dhall-lsp-server.cabal | 2 +- dhall-openapi/dhall-openapi.cabal | 2 +- dhall-yaml/dhall-yaml.cabal | 2 +- dhall/dhall.cabal | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/dhall-csv/dhall-csv.cabal b/dhall-csv/dhall-csv.cabal index 9458d493c..9984efbcb 100644 --- a/dhall-csv/dhall-csv.cabal +++ b/dhall-csv/dhall-csv.cabal @@ -33,7 +33,7 @@ Library Hs-Source-Dirs: src Build-Depends: base >= 4.12.0.0 && < 5 , - bytestring < 0.12, + bytestring < 0.13, cassava >= 0.5.0.0 && < 0.6 , containers >= 0.5.9 && < 0.7 , either , diff --git a/dhall-json/dhall-json.cabal b/dhall-json/dhall-json.cabal index e8d3f2bba..075263e23 100644 --- a/dhall-json/dhall-json.cabal +++ b/dhall-json/dhall-json.cabal @@ -38,7 +38,7 @@ Library Hs-Source-Dirs: src Build-Depends: base >= 4.11.0.0 && < 5 , - aeson >= 1.4.6.0 && < 2.2 , + aeson >= 1.4.6.0 && < 2.3 , aeson-pretty >= 0.8.0 && < 0.9 , aeson-yaml >= 1.1.0 && < 1.2 , bytestring < 0.13, diff --git a/dhall-lsp-server/dhall-lsp-server.cabal b/dhall-lsp-server/dhall-lsp-server.cabal index 4a9fca071..e8cfbb01a 100644 --- a/dhall-lsp-server/dhall-lsp-server.cabal +++ b/dhall-lsp-server/dhall-lsp-server.cabal @@ -42,7 +42,7 @@ library src default-extensions: RecordWildCards OverloadedStrings build-depends: - aeson >= 1.3.1.1 && < 2.2 + aeson >= 1.3.1.1 && < 2.3 , aeson-pretty >= 0.8.7 && < 0.9 , base >= 4.11 && < 5 , bytestring >= 0.10.8.2 && < 0.12 diff --git a/dhall-openapi/dhall-openapi.cabal b/dhall-openapi/dhall-openapi.cabal index 1bd408c0a..074a52190 100644 --- a/dhall-openapi/dhall-openapi.cabal +++ b/dhall-openapi/dhall-openapi.cabal @@ -77,7 +77,7 @@ Library Ghc-Options: -Wall Build-Depends: base >= 4.11.0.0 && < 5 , - aeson >= 1.0.0.0 && < 2.2 , + aeson >= 1.0.0.0 && < 2.3 , containers >= 0.5.8.0 && < 0.7 , dhall >= 1.38.0 && < 1.43 , prettyprinter >= 1.7.0 && < 1.8 , diff --git a/dhall-yaml/dhall-yaml.cabal b/dhall-yaml/dhall-yaml.cabal index 48a751692..d49526bdd 100644 --- a/dhall-yaml/dhall-yaml.cabal +++ b/dhall-yaml/dhall-yaml.cabal @@ -34,7 +34,7 @@ Library HsYAML >= 0.2 && < 0.3 , HsYAML-aeson >= 0.2 && < 0.3 , base >= 4.11.0.0 && < 5 , - aeson >= 1.0.0.0 && < 2.2 , + aeson >= 1.0.0.0 && < 2.3 , bytestring < 0.13, dhall >= 1.31.0 && < 1.43, dhall-json >= 1.6.0 && < 1.8 , diff --git a/dhall/dhall.cabal b/dhall/dhall.cabal index 496b8a83e..b69066f40 100644 --- a/dhall/dhall.cabal +++ b/dhall/dhall.cabal @@ -223,7 +223,7 @@ Common common dotgen >= 0.4.2 && < 0.5 , either >= 5 && < 5.1, exceptions >= 0.8.3 && < 0.11, - filepath >= 1.4 && < 1.5 , + filepath >= 1.4 && < 1.6 , half >= 0.2.2.3 && < 0.4 , haskeline >= 0.7.2.1 && < 0.9 , hashable >= 1.2 && < 1.5 , From 8c3bce2d33ae6188f03401f0e6f236fbdddc6c52 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Thu, 25 Apr 2024 22:28:11 +0200 Subject: [PATCH 2/4] port beginning --- dhall/src/Dhall/Import/Headers.hs | 5 +++ dhall/src/Dhall/Marshal/Decode.hs | 64 ++++++++++++++++----------- dhall/src/Dhall/Parser/Combinators.hs | 8 ++++ dhall/src/Dhall/Parser/Expression.hs | 5 +++ dhall/src/Dhall/Tags.hs | 5 ++- 5 files changed, 60 insertions(+), 27 deletions(-) diff --git a/dhall/src/Dhall/Import/Headers.hs b/dhall/src/Dhall/Import/Headers.hs index e61f2dcb7..e87f524e7 100644 --- a/dhall/src/Dhall/Import/Headers.hs +++ b/dhall/src/Dhall/Import/Headers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -9,7 +10,11 @@ module Dhall.Import.Headers , toOriginHeaders ) where +#if (MIN_VERSION_base(4,10,0)) +import Control.Applicative (Alternative (..)) +#else import Control.Applicative (Alternative (..), liftA2) +#endif import Control.Exception (SomeException) import Control.Monad.Catch (handle, throwM) import Data.Text (Text) diff --git a/dhall/src/Dhall/Marshal/Decode.hs b/dhall/src/Dhall/Marshal/Decode.hs index ab571ad33..c6ccf050d 100644 --- a/dhall/src/Dhall/Marshal/Decode.hs +++ b/dhall/src/Dhall/Marshal/Decode.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingStrategies #-} @@ -135,7 +136,11 @@ module Dhall.Marshal.Decode ) where +#if (MIN_VERSION_base(4,10,0)) +import Control.Applicative (empty) +#else import Control.Applicative (empty, liftA2) +#endif import Control.Exception (Exception) import Control.Monad (guard) import Control.Monad.Trans.State.Strict @@ -1291,14 +1296,19 @@ setHelper size toSet (Decoder extractIn expectedIn) = Decoder extractOut expecte vSet = toSet vList sameSize = size vSet == Data.Sequence.length vSeq duplicates = vList List.\\ Data.Foldable.toList vSet - err | length duplicates == 1 = + err = + case duplicates of + (duplicate : []) -> "One duplicate element in the list: " - <> (Data.Text.pack $ show $ head duplicates) - | otherwise = Data.Text.pack $ unwords + <> (Data.Text.pack $ show duplicate) + (duplicate : _) -> + Data.Text.pack $ unwords [ show $ length duplicates , "duplicates were found in the list, including" - , show $ head duplicates + , show duplicate ] + ([]) -> + "No duplicate (code branch assumed to be unreachable)." Failure f -> Failure f extractOut expr = typeError expectedOut expr @@ -1605,13 +1615,15 @@ instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractError s a) show (TypeMismatch e) = show e show (ExpectedTypeError e) = show e show (ExtractError es) = - _ERROR <> ": Failed extraction \n\ - \ \n\ - \The expression type-checked successfully but the transformation to the target \n\ - \type failed with the following error: \n\ - \ \n\ - \" <> Data.Text.unpack es <> "\n\ - \ \n" + unlines + [ _ERROR <> ": Failed extraction " + , " " + , "The expression type-checked successfully but the transformation to the target " + , "type failed with the following error: " + , " " + , Data.Text.unpack es + , " " + ] instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a) @@ -1670,20 +1682,22 @@ instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecod instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where show InvalidDecoder { .. } = - _ERROR <> ": Invalid Dhall.Decoder \n\ - \ \n\ - \Every Decoder must provide an extract function that does not fail with a type \n\ - \error if an expression matches the expected type. You provided a Decoder that \n\ - \disobeys this contract \n\ - \ \n\ - \The Decoder provided has the expected dhall type: \n\ - \ \n\ - \" <> show txt0 <> "\n\ - \ \n\ - \and it threw a type error during extraction from the well-typed expression: \n\ - \ \n\ - \" <> show txt1 <> "\n\ - \ \n" + unlines + [ _ERROR <> ": Invalid Dhall.Decoder " + , " " + , "Every Decoder must provide an extract function that does not fail with a type " + , "error if an expression matches the expected type. You provided a Decoder that " + , "disobeys this contract " + , " " + , "The Decoder provided has the expected dhall type: " + , " " + , show txt0 + , " " + , "and it threw a type error during extraction from the well-typed expression: " + , " " + , show txt1 + , " " + ] where txt0 = Dhall.Util.insert invalidDecoderExpected txt1 = Dhall.Util.insert invalidDecoderExpression diff --git a/dhall/src/Dhall/Parser/Combinators.hs b/dhall/src/Dhall/Parser/Combinators.hs index c8a035cfb..43721c267 100644 --- a/dhall/src/Dhall/Parser/Combinators.hs +++ b/dhall/src/Dhall/Parser/Combinators.hs @@ -23,7 +23,11 @@ module Dhall.Parser.Combinators ) where +#if (MIN_VERSION_base(4,10,0)) +import Control.Applicative (Alternative (..)) +#else import Control.Applicative (Alternative (..), liftA2) +#endif import Control.Exception (Exception) import Control.Monad (MonadPlus (..)) import Data.String (IsString (..)) @@ -169,6 +173,10 @@ instance Text.Megaparsec.MonadParsec Void Text Parser where updateParserState f = Parser (Text.Megaparsec.updateParserState f) +#if (MIN_VERSION_megaparsec(9,4,0)) + mkParsec f = Parser (Text.Megaparsec.mkParsec f) +#endif + instance Semigroup a => Semigroup (Parser a) where (<>) = liftA2 (<>) diff --git a/dhall/src/Dhall/Parser/Expression.hs b/dhall/src/Dhall/Parser/Expression.hs index 45459327e..6226f240f 100644 --- a/dhall/src/Dhall/Parser/Expression.hs +++ b/dhall/src/Dhall/Parser/Expression.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,7 +8,11 @@ -- | Parsing Dhall expressions. module Dhall.Parser.Expression where +#if (MIN_VERSION_base(4,10,0)) +import Control.Applicative (Alternative (..), optional) +#else import Control.Applicative (Alternative (..), liftA2, optional) +#endif import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) diff --git a/dhall/src/Dhall/Tags.hs b/dhall/src/Dhall/Tags.hs index 4eab0a302..efef2c6dc 100644 --- a/dhall/src/Dhall/Tags.hs +++ b/dhall/src/Dhall/Tags.hs @@ -8,7 +8,7 @@ module Dhall.Tags ) where import Control.Exception (SomeException (..), handle) -import Data.List (foldl', isSuffixOf) +import Data.List (foldl', isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) @@ -261,9 +261,10 @@ inputToFiles followSyms suffixes (InputFile path) = go path then return [] else do -- filter . .. and hidden files .* - contents <- fmap (filter ((/=) '.' . head)) + contents <- fmap (filter (not . isHiddenOrSpecialDirectoryLinkName)) (SD.getDirectoryContents p) concat <$> mapM (go . () p) contents else return [p | matchingSuffix || p == path] where matchingSuffix = maybe True (any (`isSuffixOf` p)) suffixes isSymLink = SD.pathIsSymbolicLink p + isHiddenOrSpecialDirectoryLinkName filename = "." `isPrefixOf` filename From 16b8524e94caa027412f6b3c01a6c14ca82abee5 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Thu, 25 Apr 2024 22:53:38 +0200 Subject: [PATCH 3/4] Compile with -werror. --- dhall-csv/src/Dhall/CsvToDhall.hs | 3 ++- dhall-docs/src/Dhall/Docs/CodeRenderer.hs | 3 ++- dhall-docs/src/Dhall/Docs/Comment.hs | 2 +- dhall-openapi/src/Dhall/Kubernetes/Convert.hs | 23 ++++++++++--------- dhall-openapi/src/Dhall/Kubernetes/Types.hs | 18 +++++++++------ 5 files changed, 28 insertions(+), 21 deletions(-) diff --git a/dhall-csv/src/Dhall/CsvToDhall.hs b/dhall-csv/src/Dhall/CsvToDhall.hs index 3a71ea2e9..5dab35f34 100644 --- a/dhall-csv/src/Dhall/CsvToDhall.hs +++ b/dhall-csv/src/Dhall/CsvToDhall.hs @@ -159,6 +159,7 @@ import Prettyprinter (Pretty) import qualified Data.Csv import qualified Data.HashMap.Strict as HashMap +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Sequence as Sequence import qualified Data.Text import qualified Dhall.Core as Core @@ -273,7 +274,7 @@ dhallFromCsv Conversion{..} typeExpr = listConvert (Core.normalize typeExpr) recordConvert (Core.Record record) csvRecord | badKeys <- lefts (map decodeUtf8' (HashMap.keys csvRecord)) , not (null badKeys) - = Left $ UnicodeError (head badKeys) -- Only report first key that failed to be decoded + = Left $ UnicodeError (NonEmpty.head . NonEmpty.fromList $ badKeys) -- Only report first key that failed to be decoded | extraKeys <- (map decodeUtf8 $ HashMap.keys csvRecord) \\ Map.keys record , strictRecs && not (null extraKeys) = Left $ UnhandledFields extraKeys diff --git a/dhall-docs/src/Dhall/Docs/CodeRenderer.hs b/dhall-docs/src/Dhall/Docs/CodeRenderer.hs index 51224bb64..29841c660 100644 --- a/dhall-docs/src/Dhall/Docs/CodeRenderer.hs +++ b/dhall-docs/src/Dhall/Docs/CodeRenderer.hs @@ -56,6 +56,7 @@ import Text.Megaparsec.Pos (SourcePos (..)) import qualified Control.Monad.Trans.Writer.Strict as Writer import qualified Data.List +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Set as Set import qualified Data.Text as Text @@ -374,7 +375,7 @@ renderCodeWithHyperLinks contents expr = pre_ $ go (1, 1) lines_ imports -- calls to `head` and `last` here should never fail since `importLines` -- have at least one element - let (firstImportLine, lastImportLine) = (head importLines, last importLines) + let (firstImportLine, lastImportLine) = (NonEmpty.head . NonEmpty.fromList $ importLines, last importLines) let prefixCols = Text.take (importStartCol - currCol) firstImportLine let suffixCols = Text.drop (importEndCol - currCol) lastImportLine diff --git a/dhall-docs/src/Dhall/Docs/Comment.hs b/dhall-docs/src/Dhall/Docs/Comment.hs index 7bab3889c..9acb085d3 100644 --- a/dhall-docs/src/Dhall/Docs/Comment.hs +++ b/dhall-docs/src/Dhall/Docs/Comment.hs @@ -189,7 +189,7 @@ parseDhallDocsText (BlockComment blockComment) = Just e -> DhallDocsText e where joinedText = Data.Text.strip $ Data.Text.unlines reIndentedLines - commentLines = tail $ Data.Text.lines blockComment + commentLines = NonEmpty.tail $ NonEmpty.fromList $ Data.Text.lines blockComment leadingSpaces = Data.Text.takeWhile isSpace where diff --git a/dhall-openapi/src/Dhall/Kubernetes/Convert.hs b/dhall-openapi/src/Dhall/Kubernetes/Convert.hs index 92fb0f6fb..3f32cb52a 100644 --- a/dhall-openapi/src/Dhall/Kubernetes/Convert.hs +++ b/dhall-openapi/src/Dhall/Kubernetes/Convert.hs @@ -22,15 +22,16 @@ import Data.Text (Text) import Dhall.Kubernetes.Types import GHC.Generics (Generic, Rep) -import qualified Data.Char as Char -import qualified Data.List as List -import qualified Data.Map.Strict as Data.Map -import qualified Data.Maybe as Maybe -import qualified Data.Set as Set -import qualified Data.Sort as Sort -import qualified Data.Text as Text -import qualified Data.Tuple as Tuple -import qualified Dhall.Core as Dhall +import qualified Data.Char as Char +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Map.Strict as Data.Map +import qualified Data.Maybe as Maybe +import qualified Data.Set as Set +import qualified Data.Sort as Sort +import qualified Data.Text as Text +import qualified Data.Tuple as Tuple +import qualified Dhall.Core as Dhall import qualified Dhall.Map import qualified Dhall.Optics import qualified Data.Map as Map @@ -112,7 +113,7 @@ mkImport :: Data.Map.Map Prefix Dhall.Import -> [Text] -> Text -> Dhall.Import mkImport prefixMap components file = case Data.Map.toList filteredPrefixMap of [] -> localImport - xs -> (snd . head $ Sort.sortOn (Text.length . fst) xs) <> localImport + xs -> (snd . NonEmpty.head . NonEmpty.fromList $ Sort.sortOn (Text.length . fst) xs) <> localImport where localImport = Dhall.Import{..} importMode = Dhall.Code @@ -206,7 +207,7 @@ toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions definitions to case hierarchy of [] -> "" [ModelName{..}] -> Text.unpack (last $ Text.splitOn "." unModelName) - _ -> getModelName (tail hierarchy) + _ -> getModelName (NonEmpty.tail . NonEmpty.fromList $ hierarchy) convertAndAccumWithKey :: ModelHierarchy -> Data.Map.Map ModelName Definition -> ModelName -> Definition -> (Data.Map.Map ModelName Definition, Expr) convertAndAccumWithKey modelHierarchy accDefs k v = (mergeNoConflicts equalsIgnoringDescription accDefs leftOverDefs, expr) diff --git a/dhall-openapi/src/Dhall/Kubernetes/Types.hs b/dhall-openapi/src/Dhall/Kubernetes/Types.hs index 8bde4132b..1a38c01af 100644 --- a/dhall-openapi/src/Dhall/Kubernetes/Types.hs +++ b/dhall-openapi/src/Dhall/Kubernetes/Types.hs @@ -105,10 +105,14 @@ data BaseData = BaseData } deriving (Generic, Show, Eq) instance FromJSON BaseData where - parseJSON = withArray "array of values" $ \arr -> withObject "baseData" (\o -> do - group <- o .:? "group" .!= "" - kind <- o .: "kind" - version <- o .: "version" - let apiVersion = (if Text.null group then "" else group <> "/") <> version - pure BaseData{..}) - (head $ Vector.toList arr) + parseJSON = withArray "array of values" $ \arr -> do + case Vector.toList arr of + [] -> fail "missing baseData object in array" + (item:_) -> + withObject "baseData" (\o -> do + group <- o .:? "group" .!= "" + kind <- o .: "kind" + version <- o .: "version" + let apiVersion = (if Text.null group then "" else group <> "/") <> version + pure BaseData{..}) + item From a9cee5dfd68797e837d68f8a15f24c793e03cdee Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Sat, 27 Apr 2024 21:57:10 +0200 Subject: [PATCH 4/4] Mask liftA2 only since base-4.19 --- dhall/src/Dhall/Import/Headers.hs | 2 +- dhall/src/Dhall/Marshal/Decode.hs | 2 +- dhall/src/Dhall/Parser/Combinators.hs | 2 +- dhall/src/Dhall/Parser/Expression.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/dhall/src/Dhall/Import/Headers.hs b/dhall/src/Dhall/Import/Headers.hs index e87f524e7..4cd31c38b 100644 --- a/dhall/src/Dhall/Import/Headers.hs +++ b/dhall/src/Dhall/Import/Headers.hs @@ -10,7 +10,7 @@ module Dhall.Import.Headers , toOriginHeaders ) where -#if (MIN_VERSION_base(4,10,0)) +#if (MIN_VERSION_base(4,19,0)) import Control.Applicative (Alternative (..)) #else import Control.Applicative (Alternative (..), liftA2) diff --git a/dhall/src/Dhall/Marshal/Decode.hs b/dhall/src/Dhall/Marshal/Decode.hs index c6ccf050d..e5003a7b3 100644 --- a/dhall/src/Dhall/Marshal/Decode.hs +++ b/dhall/src/Dhall/Marshal/Decode.hs @@ -136,7 +136,7 @@ module Dhall.Marshal.Decode ) where -#if (MIN_VERSION_base(4,10,0)) +#if (MIN_VERSION_base(4,19,0)) import Control.Applicative (empty) #else import Control.Applicative (empty, liftA2) diff --git a/dhall/src/Dhall/Parser/Combinators.hs b/dhall/src/Dhall/Parser/Combinators.hs index 43721c267..10f86431f 100644 --- a/dhall/src/Dhall/Parser/Combinators.hs +++ b/dhall/src/Dhall/Parser/Combinators.hs @@ -23,7 +23,7 @@ module Dhall.Parser.Combinators ) where -#if (MIN_VERSION_base(4,10,0)) +#if (MIN_VERSION_base(4,19,0)) import Control.Applicative (Alternative (..)) #else import Control.Applicative (Alternative (..), liftA2) diff --git a/dhall/src/Dhall/Parser/Expression.hs b/dhall/src/Dhall/Parser/Expression.hs index 6226f240f..4dc39bf19 100644 --- a/dhall/src/Dhall/Parser/Expression.hs +++ b/dhall/src/Dhall/Parser/Expression.hs @@ -8,7 +8,7 @@ -- | Parsing Dhall expressions. module Dhall.Parser.Expression where -#if (MIN_VERSION_base(4,10,0)) +#if (MIN_VERSION_base(4,19,0)) import Control.Applicative (Alternative (..), optional) #else import Control.Applicative (Alternative (..), liftA2, optional)