0ca6f71 · obelisk · git.iko.soy

git.iko.soy/obelisk

Bump hnix; Updates for MonadFail

commit0ca6f7190fef54cb2718ec52878ead3d3ee4cd4f authorAli Abrar <aliabrar@gmail.com> dateFri 23 Aug 2019, 12:55 (7 years ago) parent3fa3c3e

4 files changed+15−17

compare with master

unifiedsplit

default.nix+1−6 lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+7−6 lib/cliapp/src/Obelisk/CliApp/Demo.hs+2−1 lib/cliapp/src/Obelisk/CliApp/Process.hs+5−4

default.nix+1−6

@@ -33,12 +33,7 @@ let

3333 (self: super: let

3434 pkgs = self.callPackage ({ pkgs }: pkgs) {};

3535 in {

36− hnix = pkgs.haskell.lib.dontCheck (self.callCabal2nix "hnix" (pkgs.fetchFromGitHub {

37− owner = "haskell-nix";

38− repo = "hnix";

39− rev = "42afdc21da5d9e076eab57eaa42bfdde938192b8";

40− sha256 = "0psw384dx9bw2dp93xrzw8rd9amvcwgzn64jzzwby7sfspj6k349";

41− }) {});

36+ hnix = pkgs.haskell.lib.dontCheck (self.callPackage (pkgs.hackGet ./dep/hnix) {});

4237 })

4338

4439 pkgs.obeliskExecutableConfig.haskellOverlay

lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+7−6

@@ -19,6 +19,7 @@ import Control.Applicative ((<|>))

1919import Control.Exception (handleJust, try, throwIO)

2020import Control.Monad (forM, liftM)

2121import Control.Monad.IO.Class (liftIO)

22+import Control.Monad.Fail (MonadFail)

2223import Data.Attoparsec.ByteString (parseOnly, endOfInput)

2324import Data.ByteString (ByteString)

2425import qualified Data.ByteString as BS

@@ -38,7 +39,7 @@ import System.Posix (getFileStatus, fileSize)

3839-- current version of the asset

3940-- (e.g. @0rx5yvkkgkig2pcqf4ngi1l7vh89qqajdzc6aiayaibyhvj0d853-test.png@). Hashed

4041-- asset names will be sent with permanent caching headers.

41−serveAssets :: MonadSnap m => FilePath -> FilePath -> m ()

42+serveAssets :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> m ()

4243serveAssets = serveAssets' True

4344

4445-- | Serve static assets from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.

@@ -47,15 +48,15 @@ serveAssets = serveAssets' True

4748-- browser for the logical asset name (e.g. @test.png@) but instead the current

4849-- version of the asset with to point the browser at the unique filename for the

4950-- current version of the asset.

50−serveAssetsInPlace :: MonadSnap m => FilePath -> FilePath -> m ()

51+serveAssetsInPlace :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> m ()

5152serveAssetsInPlace = serveAssets' False

5253

5354-- | Like 'serveAssets', but only serves a single specified asset

54−serveAsset :: MonadSnap m => FilePath -> FilePath -> FilePath -> m ()

55+serveAsset :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> FilePath -> m ()

5556serveAsset = serveAsset' True

5657

5758-- | Like 'serveAssetsInPlace', but only serves a single specified asset

58−serveAssetInPlace :: MonadSnap m => FilePath -> FilePath -> FilePath -> m ()

59+serveAssetInPlace :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> FilePath -> m ()

5960serveAssetInPlace = serveAsset' False

6061

6162-- | Serve static assets from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.

@@ -63,13 +64,13 @@ serveAssetInPlace = serveAsset' False

6364-- For assets generated from @assets.nix@, the @Bool@ argument @doRedirect@ controls whether redirects will be sent to the browser if a request is made for

6465-- an unhashed asset name, e.g. @test.png@. For @True@, a redirect will be sent, yielding more round trips to the server but better caching behavior if the

6566-- asset doesn't change often. Conversely for @False@, the asset will be served "in place" but made uncacheable.

66−serveAssets' :: MonadSnap m => Bool -> FilePath -> FilePath -> m ()

67+serveAssets' :: (MonadSnap m, MonadFail m) => Bool -> FilePath -> FilePath -> m ()

6768serveAssets' doRedirect base fallback = do

6869 pRaw <- getSafePath

6970 serveAsset' doRedirect base fallback $ if "/" `isSuffixOf` pRaw || pRaw == "" then pRaw <> "index.html" else pRaw

7071

7172-- | Serve a single static asset from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.

72−serveAsset' :: MonadSnap m => Bool -> FilePath -> FilePath -> FilePath -> m ()

73+serveAsset' :: (MonadFail m, MonadSnap m) => Bool -> FilePath -> FilePath -> FilePath -> m ()

7374serveAsset' doRedirect base fallback p = do

7475 assetType <- liftIO $ try $ BS.readFile $ base </> p </> "type"

7576 case assetType of

lib/cliapp/src/Obelisk/CliApp/Demo.hs+2−1

@@ -4,6 +4,7 @@

44module Obelisk.CliApp.Demo where

66import Control.Concurrent (threadDelay)

7+import Control.Monad.Fail (MonadFail)

78import Control.Monad.IO.Class

89import Data.Semigroup ((<>))

910import qualified Data.Text as T

@@ -14,7 +15,7 @@ import Control.Monad.Catch (MonadMask)

1415import Obelisk.CliApp

1516

1617cliDemo

17− :: ( MonadIO m, MonadMask m

18+ :: ( MonadIO m, MonadMask m, MonadFail m

1819 , CliLog m, HasCliConfig e m, CliThrow e m, AsProcessFailure e, AsUnstructuredError e)

1920 => m ()

2021cliDemo = withSpinner "CLI Demo" $ do

lib/cliapp/src/Obelisk/CliApp/Process.hs+5−4

@@ -24,6 +24,7 @@ module Obelisk.CliApp.Process

2424

2525import Control.Monad ((<=<), join, void)

2626import Control.Monad.Except (throwError)

27+import Control.Monad.Fail (MonadFail)

2728import Control.Monad.IO.Class (MonadIO, liftIO)

2829import Control.Lens (Prism', review)

2930import qualified Data.ByteString as BS

@@ -60,7 +61,7 @@ instance AsProcessFailure ProcessFailure where

6061 asProcessFailure = id

6162

6263readProcessAndLogStderr

63− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

64+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

6465 => Severity -> CreateProcess -> m Text

6566readProcessAndLogStderr sev process = do

6667 (out, _err) <- withProcess process $ \_out err -> do

@@ -82,7 +83,7 @@ readCreateProcessWithExitCode process = do

8283-- which case it is advisable to call it with a non-Error severity for stderr, like

8384-- `callProcessAndLogOutput (Debug, Debug)`.

8485readProcessAndLogOutput

85− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

86+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

8687 => (Severity, Severity) -> CreateProcess -> m Text

8788readProcessAndLogOutput (sev_out, sev_err) process = do

8889 (_, Just out, Just err, p) <- createProcess $ process

@@ -106,7 +107,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

106107-- `callProcessAndLogOutput (Debug, Debug)`.

107108callProcessAndLogOutput

108109

109− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

110+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

110111 => (Severity, Severity) -> CreateProcess -> m ()

111112callProcessAndLogOutput (sev_out, sev_err) process =

112113 void $ withProcess process $ \out err -> do

@@ -150,7 +151,7 @@ callCommand cmd = do

150151 liftIO $ Process.callCommand cmd

151152

152153withProcess

153− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

154+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

154155 => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

155156withProcess process f = do -- TODO: Use bracket.

156157 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.