diff --git a/.gitignore b/.gitignore index 5d3e75b41..06046e8d8 100644 --- a/.gitignore +++ b/.gitignore @@ -14,5 +14,5 @@ cabal.project.local **/ghcid-output.txt # HLS specific files -lib/cabal.project +#lib/cabal.project lib/cabal.project.local diff --git a/all-tests.nix b/all-tests.nix index b4970cef3..a34774a4a 100644 --- a/all-tests.nix +++ b/all-tests.nix @@ -5,7 +5,7 @@ let nginxRoot = "/run/nginx"; obelisk = import ./default.nix {}; # Get NixOS a pre-release 20.03 that contains the python based tests and recursive nix - pkgs = import (builtins.fetchTarball https://github.com/nixos/nixpkgs/archive/3de5266.tar.gz) {}; + pkgs = import (builtins.fetchTarball https://github.com/nixos/nixpkgs/archive/3de5266b255cf3bd41438d2cfb0698420a33302e.tar.gz) {}; sshKeys = import (pkgs.path + /nixos/tests/ssh-keys.nix) pkgs; make-test = import (pkgs.path + /nixos/tests/make-test-python.nix); obelisk-everywhere = (import ./all-builds.nix { inherit supportedSystems; }).x86_64-linux.cache; diff --git a/dep/nix-thunk/github.json b/dep/nix-thunk/github.json index 6cba516f2..ced356f30 100644 --- a/dep/nix-thunk/github.json +++ b/dep/nix-thunk/github.json @@ -3,6 +3,6 @@ "repo": "nix-thunk", "branch": "master", "private": false, - "rev": "2b65d2cbf83e77a90b4103418d037ba5b0b32e77", - "sha256": "07pr014iifyy1xaiqamkx78xfszr67g8kzysmzgzms0a4470k1i9" + "rev": "682327c1f7859eaa34a7863bc3b8cccce3f5d038", + "sha256": "0d7yibmqbgw02xl7lb3m75pg8ih4mxwy1hk4mra2fvfx6nbhv442" } diff --git a/lib/asset/manifest/obelisk-asset-manifest.cabal b/lib/asset/manifest/obelisk-asset-manifest.cabal index a549d6564..916b965b3 100644 --- a/lib/asset/manifest/obelisk-asset-manifest.cabal +++ b/lib/asset/manifest/obelisk-asset-manifest.cabal @@ -24,6 +24,7 @@ library , filepath , template-haskell , text + , th-abstraction >= 0.6 , transformers , unix-compat , vector @@ -39,6 +40,9 @@ library -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2 -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls + if arch(javascript) + buildable: False + executable obelisk-asset-manifest-generate default-language: Haskell2010 hs-source-dirs: src-bin diff --git a/lib/asset/manifest/src/Obelisk/Asset/Promoted.hs b/lib/asset/manifest/src/Obelisk/Asset/Promoted.hs index 3affdf4f4..ba13b94df 100644 --- a/lib/asset/manifest/src/Obelisk/Asset/Promoted.hs +++ b/lib/asset/manifest/src/Obelisk/Asset/Promoted.hs @@ -1,6 +1,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskellQuotes #-} + module Obelisk.Asset.Promoted ( writeStaticProject , declareStatic @@ -12,6 +13,7 @@ import Obelisk.Asset.Gather import Data.Foldable import Language.Haskell.TH (pprint) import Language.Haskell.TH.Syntax hiding (lift) +import Language.Haskell.TH.Datatype.TyVarBndr (kindedTVFlag) import GHC.TypeLits import Data.Sequence (Seq) import qualified Data.Sequence as Seq @@ -88,7 +90,7 @@ staticClass = do let n x = Name (OccName x) NameS className = n "StaticFile" methodName = n "hashedPath" - cls = ClassD [] className [KindedTV (n "s") (ConT ''Symbol)] [] [SigD methodName (ConT ''Text)] + cls = ClassD [] className [kindedTVFlag (n "s") BndrReq (ConT ''Symbol)] [] [SigD methodName (ConT ''Text)] tell $ Seq.singleton cls return $ StaticContext { _staticContext_className = className diff --git a/lib/asset/manifest/src/Obelisk/Asset/TH.hs b/lib/asset/manifest/src/Obelisk/Asset/TH.hs index bdb6e3dc0..9de64a3b2 100644 --- a/lib/asset/manifest/src/Obelisk/Asset/TH.hs +++ b/lib/asset/manifest/src/Obelisk/Asset/TH.hs @@ -86,4 +86,4 @@ staticAssetWorker root staticOut fp = do exists <- runIO $ doesFileExist $ staticOut fp when (not exists) $ fail $ "The file " <> fp <> " was not found in " <> staticOut - returnQ $ LitE $ StringL $ root fp + return $ LitE $ StringL $ root fp diff --git a/lib/asset/serve-snap/obelisk-asset-serve-snap.cabal b/lib/asset/serve-snap/obelisk-asset-serve-snap.cabal index 855f55e14..73436f6da 100644 --- a/lib/asset/serve-snap/obelisk-asset-serve-snap.cabal +++ b/lib/asset/serve-snap/obelisk-asset-serve-snap.cabal @@ -33,3 +33,6 @@ library ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2 -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls + + if arch(javascript) + buildable: False diff --git a/lib/backend/obelisk-backend.cabal b/lib/backend/obelisk-backend.cabal index 2f4a6b3fa..83a3e0fa6 100644 --- a/lib/backend/obelisk-backend.cabal +++ b/lib/backend/obelisk-backend.cabal @@ -28,3 +28,6 @@ library universe exposed-modules: Obelisk.Backend ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O + + if arch(javascript) + buildable: False diff --git a/lib/backend/src/Obelisk/Backend.hs b/lib/backend/src/Obelisk/Backend.hs index 9d15d6da8..51a8caead 100644 --- a/lib/backend/src/Obelisk/Backend.hs +++ b/lib/backend/src/Obelisk/Backend.hs @@ -10,6 +10,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module Obelisk.Backend ( Backend (..) , BackendConfig (..) @@ -45,15 +46,20 @@ module Obelisk.Backend import Control.Monad.Fail (MonadFail) import Data.Monoid ((<>)) #endif -#endif - +#if __GLASGOW_HASKELL__ >= 906 import Control.Monad +import Control.Monad.IO.Class +#else import Control.Monad.Except +#endif +#endif + import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BSC8 import Data.Default (Default (..)) import Data.Dependent.Sum import Data.Functor.Identity +import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) @@ -202,7 +208,7 @@ data StaticAssets = StaticAssets } deriving (Show, Read, Eq, Ord) -data GhcjsAppRoute :: (* -> *) -> * -> * where +data GhcjsAppRoute :: (Type -> Type) -> Type -> Type where GhcjsAppRoute_App :: appRouteComponent a -> GhcjsAppRoute appRouteComponent a GhcjsAppRoute_Resource :: GhcjsAppRoute appRouteComponent [Text] diff --git a/lib/cabal.dependencies.project b/lib/cabal.dependencies.project new file mode 100644 index 000000000..7496c2cf6 --- /dev/null +++ b/lib/cabal.dependencies.project @@ -0,0 +1,32 @@ +index-state: 2024-08-04T00:00:00Z +allow-newer: all + +constraints: + hnix-store-core < 0.7 + , hnix-store-remote < 0.7 + +source-repository-package + type: git + location: https://github.com/ymeister/splitmix.git + tag: fe4d9e4ec01ba7caf8053d6888ec2e7f89fad874 + --sha256: 19fbwcmdmb9w34cp19r2j4qywhnjmxxdv4rwci29pzbvgbnnjdia + +if !arch(javascript) + source-repository-package + type: git + location: https://github.com/ymeister/hs-git.git + tag: 4534c4589fc63d76d4a28f4ca9d810bea021964b + --sha256: 12c4llylc5zls85x11inkxdwllbps77pvwyji7jv9a8c069fg6sf + + source-repository-package + type: git + location: https://github.com/mpickering/haskell-filesystem.git + tag: 2eb26717e986442796d703a80869e6826a10191e + subdir: system-fileio system-filepath + --sha256: sha256-VDShV+gkVUooMy1OtxrFfZrTAVVhWN/Ffjd6Qq0kHNM= + + source-repository-package + type: git + location: https://github.com/ymeister/unix-compat.git + tag: 339649401c876ca1f76c6f94d6b099c8c47fa9e2 + --sha256: 0j85q0mqg929nlz9ks6jaxz54pkvifpmldsvqjcz4bv6wml8m3wd diff --git a/lib/cabal.project b/lib/cabal.project new file mode 100644 index 000000000..47542b308 --- /dev/null +++ b/lib/cabal.project @@ -0,0 +1,23 @@ +if arch(javascript) + packages: + ./executable-config/inject + ./executable-config/lookup + ./frontend + ./route + ./tabulation +else + packages: + ./asset/manifest + ./asset/serve-snap + ./backend + ./command + ./executable-config/inject + ./executable-config/lookup + ./frontend + ./route + ./run + ./selftest + ./snap-extras + ./tabulation + +import: cabal.dependencies.project diff --git a/lib/command/obelisk-command.cabal b/lib/command/obelisk-command.cabal index 84028d4bb..c8f27e5fb 100644 --- a/lib/command/obelisk-command.cabal +++ b/lib/command/obelisk-command.cabal @@ -24,7 +24,7 @@ library , git , github , here - , hnix + , hnix >=0.5 , hpack , io-streams , lens @@ -39,6 +39,7 @@ library , optparse-applicative , placeholders , prettyprinter + , prettyprinter-compat-ansi-wl-pprint , process , reflex , reflex-fsnotify @@ -55,7 +56,7 @@ library , yaml , nix-thunk , cli-extras - + exposed-modules: Obelisk.App Obelisk.Command @@ -68,6 +69,9 @@ library Obelisk.Command.Preprocessor ghc-options: -Wall + if arch(javascript) + buildable: False + executable ob main-is: src-bin/ob.hs build-depends: base, obelisk-command diff --git a/lib/command/src/Obelisk/App.hs b/lib/command/src/Obelisk/App.hs index fd53233d8..aa55b56af 100644 --- a/lib/command/src/Obelisk/App.hs +++ b/lib/command/src/Obelisk/App.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -9,11 +10,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE PackageImports #-} + module Obelisk.App where import Control.Lens import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) -import Control.Monad.Fail (MonadFail) import Control.Monad.Reader (MonadIO, ReaderT (..), ask, runReaderT) import Control.Monad.Writer (WriterT) import Control.Monad.State (StateT) @@ -25,16 +26,14 @@ import Control.Monad.Log (MonadLog) import Cli.Extras.Types import "nix-thunk" Nix.Thunk (NixThunkError) +#if !MIN_VERSION_base(4,18,0) +import Control.Monad.Fail (MonadFail) +#endif + import Cli.Extras - ( CliConfig - , CliLog - , CliThrow - , CliT (..) - , ProcessFailure + ( ProcessFailure , AsProcessFailure (..) , AsUnstructuredError (..) - , HasCliConfig - , Output , runCli ) diff --git a/lib/command/src/Obelisk/Command.hs b/lib/command/src/Obelisk/Command.hs index 005bbf317..075f5342d 100644 --- a/lib/command/src/Obelisk/Command.hs +++ b/lib/command/src/Obelisk/Command.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -5,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE PackageImports #-} + module Obelisk.Command where import Control.Monad.IO.Class (MonadIO, liftIO) @@ -16,17 +18,22 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map import qualified Data.Text as T import Data.Traversable (for) +import GHC.IO.Encoding.Types (textEncodingName) +import Network.Socket (PortNumber) import Options.Applicative -import Options.Applicative.Help.Pretty (text, (<$$>)) import System.Directory import System.Environment import System.FilePath import System.Exit import qualified System.Info import System.IO (hIsTerminalDevice, Handle, stdout, stderr, hGetEncoding, hSetEncoding, mkTextEncoding) -import GHC.IO.Encoding.Types (textEncodingName) import System.Process (rawSystem) -import Network.Socket (PortNumber) + +#if MIN_VERSION_optparse_applicative(0,18,0) +import Text.PrettyPrint.ANSI.Leijen (text, (<$$>)) +#else +import Options.Applicative.Help.Pretty (text, (<$$>)) +#endif import Obelisk.App import Obelisk.Command.Deploy @@ -288,17 +295,11 @@ interpretOpts :: Parser [(FilePath, Interpret)] interpretOpts = many ( (, Interpret_Interpret) <$> strOption (common <> long "interpret" <> help - "Don't pre-build packages found in DIR when constructing the package database. The default behavior is \ - \'--interpret ', which will load everything which is unpacked into GHCi. \ - \ Use --interpret and --no-interpret multiple times to add or remove multiple trees \ - \ from the environment. Settings for right-most directories will \ - \ override settings for any identical directories given earlier." + "Don't pre-build packages found in DIR when constructing the package database. The default behavior is '--interpret ', which will load everything which is unpacked into GHCi. Use --interpret and --no-interpret multiple times to add or remove multiple trees from the environment. Settings for right-most directories will override settings for any identical directories given earlier." ) <|> (, Interpret_NoInterpret) <$> strOption (common <> long "no-interpret" <> help - "Make packages found in DIR available in the package database (but only when they are used dependencies). \ - \ This will build the packages in DIR before loading GHCi. \ - \See help for --interpret for how the two options are related." + "Make packages found in DIR available in the package database (but only when they are used dependencies). This will build the packages in DIR before loading GHCi. See help for --interpret for how the two options are related." ) ) where diff --git a/lib/command/src/Obelisk/Command/Deploy.hs b/lib/command/src/Obelisk/Command/Deploy.hs index 5afde22b6..b90ecab68 100644 --- a/lib/command/src/Obelisk/Command/Deploy.hs +++ b/lib/command/src/Obelisk/Command/Deploy.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -7,6 +8,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ViewPatterns #-} + {-| Description: Implementation of the CLI deploy commands. Deployment is done by intializing @@ -16,7 +18,6 @@ -} module Obelisk.Command.Deploy where -import Control.Applicative (liftA2) import Control.Lens import Control.Monad import Control.Monad.Catch (Exception (displayException), MonadThrow, bracket, throwM, try) @@ -47,12 +48,17 @@ import qualified Nix.Expr.Shorthands as Nix import Prettyprinter (layoutCompact) import Prettyprinter.Render.String (renderString) +#if !MIN_VERSION_base(4,18,0) +import Control.Applicative (liftA2) +#endif + import Obelisk.App (MonadObelisk, wrapNixThunkError) import Obelisk.Command.Nix import Obelisk.Command.Project import Obelisk.Command.Utils import "nix-thunk" Nix.Thunk +import "nix-thunk" Nix.Thunk.Internal (prettyReadThunkError) import Cli.Extras -- | Options passed to the `init` verb @@ -178,7 +184,7 @@ deployPush deployPath builders = do checkGitCleanStatus srcPath True >>= \case True -> wrapNixThunkError $ packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream." - Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err) + Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> prettyReadThunkError err let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr let moduleFile = deployPath "module.nix" moduleFileExists <- liftIO $ doesFileExist moduleFile diff --git a/lib/command/src/Obelisk/Command/Nix.hs b/lib/command/src/Obelisk/Command/Nix.hs index 894124c2f..9c842570f 100644 --- a/lib/command/src/Obelisk/Command/Nix.hs +++ b/lib/command/src/Obelisk/Command/Nix.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -8,6 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} + module Obelisk.Command.Nix ( Arg (..) , NixBuildConfig (..) @@ -46,9 +48,12 @@ import Data.Bool (bool) import Data.Default import Data.List (intercalate) import Data.Maybe -import Data.Monoid ((<>)) import qualified Data.Text as T +#if !MIN_VERSION_base(4,18,0) +import Data.Monoid ((<>)) +#endif + import Obelisk.App (MonadObelisk) import Cli.Extras diff --git a/lib/command/src/Obelisk/Command/Preprocessor.hs b/lib/command/src/Obelisk/Command/Preprocessor.hs index dd90786d6..911f34288 100644 --- a/lib/command/src/Obelisk/Command/Preprocessor.hs +++ b/lib/command/src/Obelisk/Command/Preprocessor.hs @@ -1,10 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Obelisk.Command.Preprocessor where import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Lazy.Builder as BU import Data.Foldable (for_) import Data.List (intersperse, isPrefixOf, sortOn) import Data.Maybe (fromMaybe) @@ -18,6 +18,12 @@ import System.FilePath (hasTrailingPathSeparator, joinPath, splitPath) import Control.Lens ((<&>)) import System.Exit +#if MIN_VERSION_bytestring(0,11,0) +import qualified Data.ByteString.Builder as BU +#else +import qualified Data.ByteString.Lazy.Builder as BU +#endif + import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage') -- | This code is intended to be executed via ghci's -pgmF preprocessor option. diff --git a/lib/command/src/Obelisk/Command/Project.hs b/lib/command/src/Obelisk/Command/Project.hs index 24ece8fc7..f95181551 100644 --- a/lib/command/src/Obelisk/Command/Project.hs +++ b/lib/command/src/Obelisk/Command/Project.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -31,8 +32,6 @@ module Obelisk.Command.Project import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked) import Control.Lens ((.~), (?~), (<&>)) import Control.Monad -import Control.Monad.Except -import Control.Monad.IO.Class (liftIO) import Control.Monad.Log import Control.Monad.State import qualified Data.Aeson as Json @@ -66,6 +65,11 @@ import System.PosixCompat.User import qualified System.Process as Proc import Text.ShellEscape (sh, bash, bytes) +#if !MIN_VERSION_base(4,18,0) +import Control.Monad.Except +import Control.Monad.IO.Class (liftIO) +#endif + import GitHub.Data.GitData (Branch) import GitHub.Data.Name (Name) @@ -350,9 +354,7 @@ mkObNixShellProc root isPure chdirToRoot packageNamesAndPaths shellAttr command let setCwd_ = if chdirToRoot then setCwd (Just root) else id pure $ setCwd_ $ nixShellRunProc $ defShellConfig & nixShellConfig_common . nixCmdConfig_target . target_expr ?~ - "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\ - \shellPackages = builtins.fromJSON pkgs;\ - \})).project.shells.${shell}" + "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {shellPackages = builtins.fromJSON pkgs;})).project.shells.${shell}" & nixShellConfig_common . nixCmdConfig_args .~ [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths) @@ -376,9 +378,7 @@ nixShellWithHoogle root isPure shell' command = do defShellConfig <- nixShellRunConfig root isPure command runProcess_ $ setCwd (Just root) $ nixShellRunProc $ defShellConfig & nixShellConfig_common . nixCmdConfig_target . target_expr ?~ - "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\ - \userSettings = super.userSettings // { withHoogle = true; };\ - \})).project.shells.${shell}" + "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {userSettings = super.userSettings // { withHoogle = true; };})).project.shells.${shell}" & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ] -- | Describes the provenance of static assets (i.e., are they the result of a derivation @@ -445,7 +445,6 @@ watchStaticFilesDerivation root = do -- derivation actually relies on, or at least use the gitignore let filterEvents x = let fn = takeFileName x - dirs = Set.fromList $ splitDirectories x ignoredFilenames = Set.fromList [ "4913" -- Vim temporary file ] diff --git a/lib/command/src/Obelisk/Command/Run.hs b/lib/command/src/Obelisk/Command/Run.hs index 4204e0cbe..3568938bc 100644 --- a/lib/command/src/Obelisk/Command/Run.hs +++ b/lib/command/src/Obelisk/Command/Run.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PackageImports #-} + module Obelisk.Command.Run where import Control.Arrow ((&&&)) @@ -45,6 +46,9 @@ import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime, defaultTimeLocale) import Data.Traversable (for) import Debug.Trace (trace) +#if MIN_VERSION_Cabal(3,4,0) +import qualified Distribution.Compat.NonEmptySet as CabalSet +#endif #if MIN_VERSION_Cabal(3,2,1) import Distribution.Compiler (CompilerFlavor(..), perCompilerFlavorToList, PerCompilerFlavor) #else @@ -78,6 +82,9 @@ import Distribution.Types.LibraryName (LibraryName(..)) import Distribution.Types.PackageName (mkPackageName) import Distribution.Types.VersionRange (anyVersion) import Distribution.Utils.Generic (toUTF8BS, readUTF8File) +#if MIN_VERSION_Cabal(3,6,0) +import Distribution.Utils.Path (getSymbolicPath) +#endif #if MIN_VERSION_Cabal(3,2,1) import qualified Distribution.Parsec.Warning as Dist #else @@ -103,6 +110,19 @@ import Obelisk.Command.Utils (findExePath, ghcidExePath) import "nix-thunk" Nix.Thunk import Cli.Extras +#if MIN_VERSION_Cabal(3,4,0) +cabalSetSingleton :: a -> CabalSet.NonEmptySet a +cabalSetSingleton = CabalSet.singleton +#else +cabalSetSingleton :: a -> Set a +cabalSetSingleton = Set.singleton +#endif + +#if !MIN_VERSION_Cabal(3,6,0) +getSymbolicPath :: a -> a +getSymbolicPath = id +#endif + data CabalPackageInfo = CabalPackageInfo { _cabalPackageInfo_packageFile :: FilePath , _cabalPackageInfo_packageName :: T.Text @@ -371,7 +391,12 @@ parseCabalPackage' pkg = runExceptT $ do Right (Left (CabalFilePath file)) -> (, file, takeBaseName file) <$> liftIO (readUTF8File file) Right (Right (HPackFilePath file)) -> do let - decodeOptions = Hpack.DecodeOptions (Hpack.ProgramName "ob") file Nothing Hpack.decodeYaml + decodeOptions = Hpack.defaultDecodeOptions + { Hpack.decodeOptionsProgramName = Hpack.ProgramName "ob" + , Hpack.decodeOptionsTarget = file + , Hpack.decodeOptionsUserDataDir = Nothing + , Hpack.decodeOptionsDecode = Hpack.decodeYaml + } liftIO (Hpack.readPackageConfig decodeOptions) >>= \case Left err -> throwError $ T.pack $ "Failed to parse " <> file <> ": " <> err Right (Hpack.DecodeResult hpackPackage _ _ _) -> pure (Hpack.renderPackage [] hpackPackage, file, Hpack.packageName hpackPackage) @@ -401,7 +426,7 @@ parseCabalPackage' pkg = runExceptT $ do , _cabalPackageInfo_packageRoot = takeDirectory packageFile , _cabalPackageInfo_buildable = buildable $ libBuildInfo lib , _cabalPackageInfo_sourceDirs = - fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib + fromMaybe (pure ".") $ NE.nonEmpty $ fmap getSymbolicPath $ hsSourceDirs $ libBuildInfo lib , _cabalPackageInfo_defaultExtensions = defaultExtensions $ libBuildInfo lib , _cabalPackageInfo_defaultLanguage = @@ -528,7 +553,7 @@ getGhciSessionSettings (toList -> packageInfos) pathBase = do map (dependencyPackageId installedPackageIndex) $ filter ((`notElem` packageNames) . depPkgName) $ concatMap _cabalPackageInfo_buildDepends packageInfos <> - [Dependency (mkPackageName "obelisk-run") anyVersion (Set.singleton LMainLibName)] + [Dependency (mkPackageName "obelisk-run") anyVersion (cabalSetSingleton LMainLibName)] dependencyPackageId installedPackageIndex dep = case lookupDependency installedPackageIndex (depPkgName dep) (depVerRange dep) of ((_version,installedPackageInfo:_) :_) -> diff --git a/lib/command/src/Obelisk/Command/Utils.hs b/lib/command/src/Obelisk/Command/Utils.hs index 10215b598..d3d92ab6b 100644 --- a/lib/command/src/Obelisk/Command/Utils.hs +++ b/lib/command/src/Obelisk/Command/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} @@ -5,9 +6,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TemplateHaskell #-} + module Obelisk.Command.Utils where import Control.Applicative hiding (many) +import Control.Monad (void) import Control.Monad.Except import Data.Bool (bool) import Data.Bifunctor @@ -17,7 +20,6 @@ import Data.List (isInfixOf) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (maybeToList) -import Data.Semigroup ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Void (Void) @@ -27,6 +29,10 @@ import qualified Text.Megaparsec.Char.Lexer as ML import Text.Megaparsec as MP import Text.Megaparsec.Char as MP +#if !MIN_VERSION_base(4,18,0) +import Data.Semigroup ((<>)) +#endif + import Obelisk.App (MonadObelisk) import Cli.Extras @@ -173,9 +179,7 @@ gitLookupDefaultBranch (refs, _) = do ref <- case M.lookup GitRef_Head refs of Just ref -> pure ref Nothing -> throwError - "No symref entry for HEAD. \ - \ Is your git version at least 1.8.5? \ - \ Otherwise `git ls-remote --symref` will not work." + "No symref entry for HEAD. Is your git version at least 1.8.5? Otherwise `git ls-remote --symref` will not work." case ref of GitRef_Branch b -> pure b _ -> throwError $ diff --git a/lib/command/src/Obelisk/Command/VmBuilder.hs b/lib/command/src/Obelisk/Command/VmBuilder.hs index 3d56b15f5..2dc44b509 100644 --- a/lib/command/src/Obelisk/Command/VmBuilder.hs +++ b/lib/command/src/Obelisk/Command/VmBuilder.hs @@ -1,14 +1,14 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} + module Obelisk.Command.VmBuilder where -import Control.Applicative (liftA2) import Control.Monad (when, unless) import Control.Monad.Catch (handle) import Control.Monad.IO.Class (liftIO) -import Data.Monoid ((<>)) import Data.String (IsString) import Data.String.Here.Uninterpolated (hereLit) import Data.Text (Text) @@ -19,6 +19,11 @@ import System.Exit (ExitCode(..)) import System.FilePath ((<.>), ()) import qualified System.Info +#if !MIN_VERSION_base(4,18,0) +import Control.Applicative (liftA2) +import Data.Monoid ((<>)) +#endif + import Obelisk.App (MonadObelisk, getObeliskUserStateDir) import Obelisk.Command.Utils (rmPath, whichPath, sshKeygenPath, nixBuildExePath, dockerPath) import Cli.Extras diff --git a/lib/executable-config/lookup/obelisk-executable-config-lookup.cabal b/lib/executable-config/lookup/obelisk-executable-config-lookup.cabal index 7e181c75f..ab163120f 100644 --- a/lib/executable-config/lookup/obelisk-executable-config-lookup.cabal +++ b/lib/executable-config/lookup/obelisk-executable-config-lookup.cabal @@ -18,7 +18,7 @@ library build-depends: android-activity ld-options: -landroid else - if impl(ghcjs) + if impl(ghcjs) || arch(javascript) hs-source-dirs: src-ghcjs, src build-depends: ghcjs-dom else diff --git a/lib/executable-config/lookup/src/Obelisk/Configs.hs b/lib/executable-config/lookup/src/Obelisk/Configs.hs index 4bb365aba..310b7128a 100644 --- a/lib/executable-config/lookup/src/Obelisk/Configs.hs +++ b/lib/executable-config/lookup/src/Obelisk/Configs.hs @@ -9,7 +9,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} + module Obelisk.Configs ( HasConfigs(..) , ConfigsT diff --git a/lib/frontend/src/Obelisk/Frontend.hs b/lib/frontend/src/Obelisk/Frontend.hs index 1feeda0f9..ca7267bd3 100644 --- a/lib/frontend/src/Obelisk/Frontend.hs +++ b/lib/frontend/src/Obelisk/Frontend.hs @@ -11,7 +11,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} + module Obelisk.Frontend ( ObeliskWidget , Frontend (..) @@ -29,6 +31,9 @@ module Obelisk.Frontend #if __GLASGOW_HASKELL__ < 810 import Data.Monoid ((<>)) #endif +#if __GLASGOW_HASKELL__ >= 906 +import Control.Monad (void, when) +#endif #endif import Prelude hiding ((.)) @@ -203,7 +208,6 @@ runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = d , PrimMonad m , MonadSample DomTimeline (Performable m) , DOM.MonadJSM m - , MonadFix (Client (HydrationDomBuilderT s DomTimeline m)) , MonadFix (Performable m) , MonadFix m , Prerender DomTimeline (HydrationDomBuilderT s DomTimeline m) diff --git a/lib/frontend/src/Obelisk/Frontend/Cookie.hs b/lib/frontend/src/Obelisk/Frontend/Cookie.hs index 5d547e63d..126e22bb6 100644 --- a/lib/frontend/src/Obelisk/Frontend/Cookie.hs +++ b/lib/frontend/src/Obelisk/Frontend/Cookie.hs @@ -9,6 +9,7 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Obelisk.Frontend.Cookie where diff --git a/lib/route/src/Obelisk/Route.hs b/lib/route/src/Obelisk/Route.hs index 27c201828..6f6f6e8b4 100644 --- a/lib/route/src/Obelisk/Route.hs +++ b/lib/route/src/Obelisk/Route.hs @@ -165,6 +165,10 @@ import Control.Lens import Control.Monad.Trans (lift) import Data.Monoid ((<>)) #endif +#if __GLASGOW_HASKELL__ >= 906 +import Control.Monad (forM, (<=<)) +import Control.Monad.Trans (lift) +#endif #endif import Control.Monad.Except @@ -184,6 +188,7 @@ import Data.Functor.Sum import Data.GADT.Compare import Data.GADT.Compare.TH import Data.GADT.Show +import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map (Map) import qualified Data.Map as Map @@ -840,10 +845,10 @@ prefixNonemptyTextEncoder p = Encoder $ pure $ EncoderImpl } packTextEncoder :: (Applicative check, Applicative parse, IsText text) => Encoder check parse String text -packTextEncoder = isoEncoder packed +packTextEncoder = viewEncoder packed unpackTextEncoder :: (Applicative check, Applicative parse, IsText text) => Encoder check parse text String -unpackTextEncoder = isoEncoder unpacked +unpackTextEncoder = viewEncoder unpacked toListMapEncoder :: (Applicative check, Applicative parse, Ord k) => Encoder check parse (Map k v) [(k, v)] toListMapEncoder = Encoder $ pure $ EncoderImpl @@ -957,10 +962,39 @@ handleEncoder recover e = Encoder $ do -- | The typical full route type comprising all of an Obelisk application's routes. -- Parameterised by the top level GADTs that define backend and frontend routes, respectively. -data FullRoute :: (* -> *) -> (* -> *) -> * -> * where +data FullRoute :: (Type -> Type) -> (Type -> Type) -> Type -> Type where FullRoute_Backend :: br a -> FullRoute br fr a FullRoute_Frontend :: ObeliskRoute fr a -> FullRoute br fr a +-- | A type which can represent Obelisk-specific resource routes, in addition to application specific routes which serve your +-- frontend. +data ObeliskRoute :: (Type -> Type) -> Type -> Type where + -- We need to have the `f a` as an argument here, because otherwise we have no way to specifically check for overlap between us and the given encoder + ObeliskRoute_App :: f a -> ObeliskRoute f a + ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a + +-- | A type representing the various resource routes served by Obelisk. These can in principle map to any physical routes you want, +-- but sane defaults are provided by 'resourceRouteSegment' +data ResourceRoute :: Type -> Type where + ResourceRoute_Static :: ResourceRoute [Text] -- This [Text] represents the *path in our static files directory*, not necessarily the URL path that the asset gets served at (although that will often be "/static/this/text/thing") + ResourceRoute_Ghcjs :: ResourceRoute [Text] + ResourceRoute_JSaddleWarp :: ResourceRoute (R JSaddleWarpRoute) + ResourceRoute_Version :: ResourceRoute () + +data JSaddleWarpRoute :: Type -> Type where + JSaddleWarpRoute_JavaScript :: JSaddleWarpRoute () + JSaddleWarpRoute_WebSocket :: JSaddleWarpRoute () + JSaddleWarpRoute_Sync :: JSaddleWarpRoute [Text] + +data IndexOnlyRoute :: Type -> Type where + IndexOnlyRoute :: IndexOnlyRoute () + +concat <$> mapM deriveRouteComponent + [ ''ResourceRoute + , ''JSaddleWarpRoute + , ''IndexOnlyRoute + ] + instance (GShow br, GShow fr) => GShow (FullRoute br fr) where gshowsPrec p = \case FullRoute_Backend x -> showParen (p > 10) (showString "FullRoute_Backend " . gshowsPrec 11 x) @@ -994,13 +1028,6 @@ mkFullRouteEncoder missing backendSegment frontendSegment = handleEncoder (const FullRoute_Backend backendRoute -> backendSegment backendRoute FullRoute_Frontend obeliskRoute -> obeliskRouteSegment obeliskRoute frontendSegment --- | A type which can represent Obelisk-specific resource routes, in addition to application specific routes which serve your --- frontend. -data ObeliskRoute :: (* -> *) -> * -> * where - -- We need to have the `f a` as an argument here, because otherwise we have no way to specifically check for overlap between us and the given encoder - ObeliskRoute_App :: f a -> ObeliskRoute f a - ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a - instance UniverseSome f => UniverseSome (ObeliskRoute f) where universeSome = concat [ (\(Some x) -> Some (ObeliskRoute_App x)) <$> universe @@ -1018,14 +1045,6 @@ instance GCompare f => GCompare (ObeliskRoute f) where gcompare (ObeliskRoute_App _) (ObeliskRoute_Resource _) = GLT gcompare (ObeliskRoute_Resource _) (ObeliskRoute_App _) = GGT --- | A type representing the various resource routes served by Obelisk. These can in principle map to any physical routes you want, --- but sane defaults are provided by 'resourceRouteSegment' -data ResourceRoute :: * -> * where - ResourceRoute_Static :: ResourceRoute [Text] -- This [Text] represents the *path in our static files directory*, not necessarily the URL path that the asset gets served at (although that will often be "/static/this/text/thing") - ResourceRoute_Ghcjs :: ResourceRoute [Text] - ResourceRoute_JSaddleWarp :: ResourceRoute (R JSaddleWarpRoute) - ResourceRoute_Version :: ResourceRoute () - -- | If there are no additional backend routes in your app (i.e. ObeliskRoute gives you all the routes you need), -- this constructs a suitable 'Encoder' to use for encoding routes to 'PageName's. If you do have additional backend routes, -- you'll want to use 'pathComponentEncoder' yourself, applied to a function that will likely use obeliskRouteSegment in order to @@ -1063,11 +1082,6 @@ resourceRouteSegment = \case ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty -data JSaddleWarpRoute :: * -> * where - JSaddleWarpRoute_JavaScript :: JSaddleWarpRoute () - JSaddleWarpRoute_WebSocket :: JSaddleWarpRoute () - JSaddleWarpRoute_Sync :: JSaddleWarpRoute [Text] - jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (R JSaddleWarpRoute) PageName jsaddleWarpRouteEncoder = pathComponentEncoder $ \case JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty @@ -1081,8 +1095,6 @@ instance GShow appRoute => GShow (ObeliskRoute appRoute) where ObeliskRoute_Resource appRoute -> showParen (prec > 10) $ showString "ObeliskRoute_Resource " . gshowsPrec 11 appRoute -data IndexOnlyRoute :: * -> * where - IndexOnlyRoute :: IndexOnlyRoute () indexOnlyRouteSegment :: (Applicative check, MonadError Text parse) => IndexOnlyRoute a -> SegmentResult check parse a indexOnlyRouteSegment = \case @@ -1101,7 +1113,7 @@ someSumEncoder = Encoder $ pure $ EncoderImpl Right (Some r) -> Some (InR r) } -data Void1 :: * -> * where {} +data Void1 :: Type -> Type where {} instance UniverseSome Void1 where universeSome = [] @@ -1293,13 +1305,6 @@ isoEncoder = viewEncoder prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b prismEncoder = reviewEncoder - -concat <$> mapM deriveRouteComponent - [ ''ResourceRoute - , ''JSaddleWarpRoute - , ''IndexOnlyRoute - ] - makePrisms ''ObeliskRoute makePrisms ''FullRoute deriveGEq ''Void1 diff --git a/lib/route/src/Obelisk/Route/Frontend.hs b/lib/route/src/Obelisk/Route/Frontend.hs index c26afbf7a..266595a10 100644 --- a/lib/route/src/Obelisk/Route/Frontend.hs +++ b/lib/route/src/Obelisk/Route/Frontend.hs @@ -60,6 +60,9 @@ module Obelisk.Route.Frontend #if __GLASGOW_HASKELL__ < 810 import Control.Monad ((<=<)) #endif +#if __GLASGOW_HASKELL__ >= 906 +import Control.Monad (when, (<=<)) +#endif #endif import Prelude hiding ((.), id) @@ -184,7 +187,7 @@ instance Adjustable t m => Adjustable t (RoutedT t r m) where traverseDMapWithKeyWithAdjust f a0 a' = RoutedT $ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) (coerce a0) $ coerce a' traverseDMapWithKeyWithAdjustWithMove f a0 a' = RoutedT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) (coerce a0) $ coerce a' -instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RoutedT t r m) where +instance MonadQuery t vs m => MonadQuery t vs (RoutedT t r m) where tellQueryIncremental = lift . tellQueryIncremental askQueryResult = lift askQueryResult queryIncremental = lift . queryIncremental @@ -278,13 +281,13 @@ eitherRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Either (Dyna eitherRouted r = RoutedT $ ReaderT $ runRoutedT r <=< eitherDyn -- | WARNING: The input 'Dynamic' must be fully constructed when this is run -strictDynWidget :: (MonadSample t m, MonadHold t m, Adjustable t m) => (a -> m b) -> RoutedT t a m (Dynamic t b) +strictDynWidget :: (MonadHold t m, Adjustable t m) => (a -> m b) -> RoutedT t a m (Dynamic t b) strictDynWidget f = RoutedT $ ReaderT $ \r -> do r0 <- sample $ current r (result0, result') <- runWithReplace (f r0) $ f <$> updated r holdDyn result0 result' -strictDynWidget_ :: (MonadSample t m, MonadHold t m, Adjustable t m) => (a -> m ()) -> RoutedT t a m () +strictDynWidget_ :: (MonadHold t m, Adjustable t m) => (a -> m ()) -> RoutedT t a m () strictDynWidget_ f = RoutedT $ ReaderT $ \r -> do r0 <- sample $ current r (_, _) <- runWithReplace (f r0) $ f <$> updated r @@ -365,7 +368,7 @@ instance (MonadHold t m, Adjustable t m) => Adjustable t (SetRouteT t r m) where traverseDMapWithKeyWithAdjust f a0 a' = SetRouteT $ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) (coerce a0) $ coerce a' traverseDMapWithKeyWithAdjustWithMove f a0 a' = SetRouteT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) (coerce a0) $ coerce a' -instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (SetRouteT t r m) where +instance (MonadQuery t vs m) => MonadQuery t vs (SetRouteT t r m) where tellQueryIncremental = lift . tellQueryIncremental askQueryResult = lift askQueryResult queryIncremental = lift . queryIncremental @@ -443,7 +446,7 @@ instance Adjustable t m => Adjustable t (RouteToUrlT r m) where traverseDMapWithKeyWithAdjust f a0 a' = RouteToUrlT $ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) (coerce a0) $ coerce a' traverseDMapWithKeyWithAdjustWithMove f a0 a' = RouteToUrlT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) (coerce a0) $ coerce a' -instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RouteToUrlT r m) where +instance MonadQuery t vs m => MonadQuery t vs (RouteToUrlT r m) where tellQueryIncremental = lift . tellQueryIncremental askQueryResult = lift askQueryResult queryIncremental = lift . queryIncremental diff --git a/lib/route/test/Main.hs b/lib/route/test/Main.hs index fb44adcd8..a1448aaa3 100644 --- a/lib/route/test/Main.hs +++ b/lib/route/test/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} @@ -20,7 +21,6 @@ module Main where import Prelude hiding (id, (.)) -import Control.Applicative (liftA2) import Control.Categorical.Bifunctor (bimap) import Control.Category (Category((.), id)) import Control.Category.Associative (associate, Associative (disassociate)) @@ -47,6 +47,10 @@ import Test.QuickCheck.Instances () import Test.Tasty (defaultMain, testGroup, TestName, TestTree) import Test.Tasty.QuickCheck (testProperty) +#if !MIN_VERSION_base(4,18,0) +import Control.Applicative (liftA2) +#endif + import Obelisk.Route import Obelisk.Route.TH diff --git a/lib/run/obelisk-run.cabal b/lib/run/obelisk-run.cabal index d1e72585e..bad662296 100644 --- a/lib/run/obelisk-run.cabal +++ b/lib/run/obelisk-run.cabal @@ -52,3 +52,5 @@ library if os(linux) cpp-options: -DIPROUTE_SUPPORTED build-depends: which + if arch(javascript) + buildable: False diff --git a/lib/selftest/obelisk-selftest.cabal b/lib/selftest/obelisk-selftest.cabal index 0f6ea1a14..f54ca2e0e 100644 --- a/lib/selftest/obelisk-selftest.cabal +++ b/lib/selftest/obelisk-selftest.cabal @@ -29,6 +29,8 @@ library exposed-modules: Obelisk.SelfTest ghc-options: -Wall + if arch(javascript) + buildable: False executable obelisk-selftest main-is: src-bin/obelisk-selftest.hs diff --git a/lib/snap-extras/obelisk-snap-extras.cabal b/lib/snap-extras/obelisk-snap-extras.cabal index 77a61aa24..58aff886e 100644 --- a/lib/snap-extras/obelisk-snap-extras.cabal +++ b/lib/snap-extras/obelisk-snap-extras.cabal @@ -19,3 +19,5 @@ library exposed-modules: Obelisk.Snap.Extras ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O + if arch(javascript) + buildable: False diff --git a/lib/tabulation/src/Data/Tabulation.hs b/lib/tabulation/src/Data/Tabulation.hs index 0938ceab1..5cd33c1c9 100644 --- a/lib/tabulation/src/Data/Tabulation.hs +++ b/lib/tabulation/src/Data/Tabulation.hs @@ -1,14 +1,16 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Data.Tabulation where import Control.Lens +import Data.Kind (Type) -- | This is a class for record types whose fields can be enumerated by an associated GADT. It's closely related to the concept of a representable functor, except without the functor part, and the fields are not all the same type. class HasFields a where - type Field a :: * -> * + type Field a :: Type -> Type fieldLens :: Field a x -> Lens' a x tabulateFieldsA :: Applicative f => (forall x. Field a x -> f x) -> f a @@ -75,12 +77,12 @@ While `tabulateFieldsA` compiles, `fieldLens` doesn't, with the same sort of err • Could not deduce: f2 ~ f from the context: x ~ f2 () bound by a pattern with constructor: - XYHKDField_X :: forall (f :: * -> *). XYHKDField (f ()), + XYHKDField_X :: forall (f :: Type -> Type). XYHKDField (f ()), in a case alternative at ../lib/tabulation/src/Data/Tabulation.hs:68:5-16 ‘f2’ is a rigid type variable bound by a pattern with constructor: - XYHKDField_X :: forall (f :: * -> *). XYHKDField (f ()), + XYHKDField_X :: forall (f :: Type -> Type). XYHKDField (f ()), in a case alternative at ../lib/tabulation/src/Data/Tabulation.hs:68:5-16 ‘f’ is a rigid type variable bound by