Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Support GHC 9.4 #2532

Merged
merged 9 commits into from
Oct 6, 2023
8 changes: 6 additions & 2 deletions dhall/dhall.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Cabal-Version: 2.4
Name: dhall
Version: 1.42.0
Version: 1.42.1
Build-Type: Simple
License: BSD-3-Clause
License-File: LICENSE
Expand Down Expand Up @@ -251,10 +251,14 @@ Common common
th-lift-instances >= 0.1.13 && < 0.2 ,
time >= 1.9 && < 1.13,
transformers >= 0.5.2.0 && < 0.7 ,
unix-compat >= 0.4.2 && < 0.7 ,
unix-compat >= 0.4.2 && < 0.8 ,
unordered-containers >= 0.1.3.0 && < 0.3 ,
vector >= 0.11.0.0 && < 0.14

if !os(windows)
Build-Depends:
unix >= 2.7 && < 2.9 ,

if flag(with-http)
CPP-Options:
-DWITH_HTTP
Expand Down
139 changes: 78 additions & 61 deletions dhall/src/Dhall/DirectoryTree.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
Expand Down Expand Up @@ -54,8 +55,12 @@ import qualified Prettyprinter as Pretty
import qualified Prettyprinter.Render.String as Pretty
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
#ifdef mingw32_HOST_OS
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

import System.IO.Error (illegalOperationErrorType, mkIOError)
#else
import qualified System.Posix.User as Posix
#endif
import qualified System.PosixCompat.Files as Posix
import qualified System.PosixCompat.User as Posix

{-| Attempt to transform a Dhall record into a directory tree where:

Expand Down Expand Up @@ -263,12 +268,24 @@ makeType = Record . Map.fromList <$> sequenceA
-- | Resolve a `User` to a numerical id.
getUser :: User -> IO UserID
getUser (UserId uid) = return uid
getUser (UserName name) = Posix.userID <$> Posix.getUserEntryForName name
getUser (UserName name) =
#ifdef mingw32_HOST_OS
ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
where x = "System.Posix.User.getUserEntryForName: not supported"
#else
Posix.userID <$> Posix.getUserEntryForName name
#endif

-- | Resolve a `Group` to a numerical id.
getGroup :: Group -> IO GroupID
getGroup (GroupId gid) = return gid
getGroup (GroupName name) = Posix.groupID <$> Posix.getGroupEntryForName name
getGroup (GroupName name) =
#ifdef mingw32_HOST_OS
ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
where x = "System.Posix.User.getGroupEntryForName: not supported"
#else
Posix.groupID <$> Posix.getGroupEntryForName name
#endif

-- | Process a `FilesystemEntry`. Writes the content to disk and apply the
-- metadata to the newly created item.
Expand Down Expand Up @@ -409,57 +426,57 @@ instance Show FilesystemError where
Pretty.renderString (Dhall.Pretty.layout message)
where
message =
Util._ERROR <> ": Not a valid directory tree expression \n\
\ \n\
\Explanation: Only a subset of Dhall expressions can be converted to a directory \n\
\tree. Specifically, record literals or maps can be converted to directories, \n\
\❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if \n\
\❰Some❱ and omitted if ❰None❱. Values of union types can also be converted if \n\
\they are an alternative which has a non-nullary constructor whose argument is of \n\
\an otherwise convertible type. Furthermore, there is a more advanced approach to \n\
\constructing a directory tree utilizing a fixpoint encoding. Consult the upstream \n\
\documentation of the `toDirectoryTree` function in the Dhall.Directory module for \n\
\further information on that. \n\
\No other type of value can be translated to a directory tree. \n\
\ \n\
\For example, this is a valid expression that can be translated to a directory \n\
\tree: \n\
\ \n\
\ \n\
\ ┌──────────────────────────────────┐ \n\
\ │ { `example.json` = \"[1, true]\" } │ \n\
\ └──────────────────────────────────┘ \n\
\ \n\
\ \n\
\In contrast, the following expression is not allowed due to containing a \n\
\❰Natural❱ field, which cannot be translated in this way: \n\
\ \n\
\ \n\
\ ┌───────────────────────┐ \n\
\ │ { `example.txt` = 1 } │ \n\
\ └───────────────────────┘ \n\
\ \n\
\ \n\
\Note that key names cannot contain path separators: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────────┐ \n\
\ │ { `directory/example.txt` = \"ABC\" } │ Invalid: Key contains a forward slash\n\
\ └─────────────────────────────────────┘ \n\
\ \n\
\ \n\
\Instead, you need to refactor the expression to use nested records instead: \n\
\ \n\
\ \n\
\ ┌───────────────────────────────────────────┐ \n\
\ │ { directory = { `example.txt` = \"ABC\" } } │ \n\
\ └───────────────────────────────────────────┘ \n\
\ \n\
\ \n\
\You tried to translate the following expression to a directory tree: \n\
\ \n\
\" <> Util.insert unexpectedExpression <> "\n\
\ \n\
Util._ERROR <> ": Not a valid directory tree expression \n\\
Copy link
Contributor Author

@lrworth lrworth Aug 25, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The GHC documentation recommends appending a space so that cpp doesn't fall over, but that causes a different error. Adding a slash like this seems to work, and does not affect the output of dhall to-directory-tree. Perhaps I should tell the GHC maintainers.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Wait, something seems amiss here. I was looking at this more closely and it does not seem to work in my local testing. The following sample code I tested:

module Main where

main :: IO ()
main = putStrLn "foo\n\\
                \bar\n\\
                \baz\n"

… gives me a lexical error:

Main.hs:4:25: error:
    lexical error in string/character literal at character '\n'
  |
4 | main = putStrLn "foo\n\\
  |                         ^

Yet clearly CI passed for your branch so I'm a bit confused. My intuition, though, is that the double trailing slash should not work, though, since I thought that would get translated to a literal slash in the string.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This works for me:

{-# LANGUAGE CPP #-}

module Main where

main :: IO ()
main = putStrLn "foo\n\\
                \bar\n\\
                \baz\n"

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ohhhh, I didn't realize that CPP changed the semantics of string literals. Alright, that clears up my confusion.

\ \n\\
\Explanation: Only a subset of Dhall expressions can be converted to a directory \n\\
\tree. Specifically, record literals or maps can be converted to directories, \n\\
\❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if \n\\
\❰Some❱ and omitted if ❰None❱. Values of union types can also be converted if \n\\
\they are an alternative which has a non-nullary constructor whose argument is of \n\\
\an otherwise convertible type. Furthermore, there is a more advanced approach to \n\\
\constructing a directory tree utilizing a fixpoint encoding. Consult the upstream \n\\
\documentation of the `toDirectoryTree` function in the Dhall.Directory module for \n\\
\further information on that. \n\\
\No other type of value can be translated to a directory tree. \n\\
\ \n\\
\For example, this is a valid expression that can be translated to a directory \n\\
\tree: \n\\
\ \n\\
\ \n\\
\ ┌──────────────────────────────────┐ \n\\
\ │ { `example.json` = \"[1, true]\" } │ \n\\
\ └──────────────────────────────────┘ \n\\
\ \n\\
\ \n\\
\In contrast, the following expression is not allowed due to containing a \n\\
\❰Natural❱ field, which cannot be translated in this way: \n\\
\ \n\\
\ \n\\
\ ┌───────────────────────┐ \n\\
\ │ { `example.txt` = 1 } │ \n\\
\ └───────────────────────┘ \n\\
\ \n\\
\ \n\\
\Note that key names cannot contain path separators: \n\\
\ \n\\
\ \n\\
\ ┌─────────────────────────────────────┐ \n\\
\ │ { `directory/example.txt` = \"ABC\" } │ Invalid: Key contains a forward slash\n\\
\ └─────────────────────────────────────┘ \n\\
\ \n\\
\ \n\\
\Instead, you need to refactor the expression to use nested records instead: \n\\
\ \n\\
\ \n\\
\ ┌───────────────────────────────────────────┐ \n\\
\ │ { directory = { `example.txt` = \"ABC\" } } │ \n\\
\ └───────────────────────────────────────────┘ \n\\
\ \n\\
\ \n\\
\You tried to translate the following expression to a directory tree: \n\\
\ \n\\
\" <> Util.insert unexpectedExpression <> "\n\\
\ \n\\
\... which is not an expression that can be translated to a directory tree. \n"

{- | This error indicates that you want to set some metadata for a file or
Expand All @@ -475,11 +492,11 @@ instance Show MetadataUnsupportedError where
Pretty.renderString (Dhall.Pretty.layout message)
where
message =
Util._ERROR <> ": Setting metadata is not supported on this platform. \n\
\ \n\
\Explanation: Your Dhall expression indicates that you intend to set some metadata \n\
\like ownership or permissions for the following file or directory: \n\
\ \n\
\" <> Pretty.pretty metadataForPath <> "\n\
\ \n\
Util._ERROR <> ": Setting metadata is not supported on this platform. \n\\
\ \n\\
\Explanation: Your Dhall expression indicates that you intend to set some metadata \n\\
\like ownership or permissions for the following file or directory: \n\\
\ \n\\
\" <> Pretty.pretty metadataForPath <> "\n\\
\ \n\\
\... which is not supported on your platform. \n"
7 changes: 6 additions & 1 deletion dhall/src/Dhall/TH.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
Expand Down Expand Up @@ -263,7 +264,11 @@ toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ =

interpretOptions = generateToInterpretOptions generateOptions typ

toTypeVar (V n i) = Syntax.PlainTV $ Syntax.mkName (Text.unpack n ++ show i)
#if MIN_VERSION_template_haskell(2,17,0)
toTypeVar (V n i) = Syntax.PlainTV (Syntax.mkName (Text.unpack n ++ show i)) ()
#else
toTypeVar (V n i) = Syntax.PlainTV (Syntax.mkName (Text.unpack n ++ show i))
#endif

toDataD typeName typeParams constructors = do
let name = Syntax.mkName (Text.unpack typeName)
Expand Down