blob: f5697e148102ac01506e389fc8f89fd1e621a21d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
-- | Transformers and exceptions.
module SlackBuilder.Trans
( SlackBuilderException(..)
, SlackBuilderT(..)
, relativeToRepository
) where
import Control.Monad.Trans.Reader (ReaderT(..), asks)
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as Text
import SlackBuilder.Config
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Exception (Exception(..))
import System.FilePath ((</>))
import Text.URI (URI)
import qualified Text.URI as URI
import qualified Codec.Compression.Lzma as Lzma
import Text.Megaparsec (ParseErrorBundle(..), errorBundlePretty)
import Conduit (Void)
data SlackBuilderException
= UpdaterNotFound Text
| UnsupportedUrlType URI
| LzmaDecompressionFailed Lzma.LzmaRet
| MalformedInfoFile (ParseErrorBundle ByteString Void)
deriving Show
instance Exception SlackBuilderException
where
displayException (UpdaterNotFound updateName) = Text.unpack
$ Text.concat ["Requested package \"", updateName, "\" was not found"]
displayException (UnsupportedUrlType givenURI) = Text.unpack
$ "Only https URLs are supported, got: " <> URI.render givenURI
displayException (LzmaDecompressionFailed Lzma.LzmaRetOK) =
"Operation completed successfully"
displayException (LzmaDecompressionFailed Lzma.LzmaRetStreamEnd) =
"End of stream was reached"
displayException (LzmaDecompressionFailed Lzma.LzmaRetUnsupportedCheck) =
"Cannot calculate the integrity check"
displayException (LzmaDecompressionFailed Lzma.LzmaRetGetCheck) =
"Integrity check type is now available"
displayException (LzmaDecompressionFailed Lzma.LzmaRetMemError) =
"Cannot allocate memory"
displayException (LzmaDecompressionFailed Lzma.LzmaRetMemlimitError) =
"Memory usage limit was reached"
displayException (LzmaDecompressionFailed Lzma.LzmaRetFormatError) =
"File format not recognized"
displayException (LzmaDecompressionFailed Lzma.LzmaRetOptionsError) =
"Invalid or unsupported options"
displayException (LzmaDecompressionFailed Lzma.LzmaRetDataError) =
"Data is corrupt"
displayException (LzmaDecompressionFailed Lzma.LzmaRetBufError) =
"No progress is possible"
displayException (LzmaDecompressionFailed Lzma.LzmaRetProgError) =
"Programming error"
displayException (MalformedInfoFile errorBundle) =
errorBundlePretty errorBundle
newtype SlackBuilderT a = SlackBuilderT
{ runSlackBuilderT :: ReaderT Settings IO a
}
relativeToRepository :: FilePath -> SlackBuilderT FilePath
relativeToRepository filePath =
(</> filePath) <$> SlackBuilderT (asks repository)
instance Functor SlackBuilderT
where
fmap f (SlackBuilderT slackBuilderT) = SlackBuilderT $ f <$> slackBuilderT
instance Applicative SlackBuilderT
where
pure = SlackBuilderT . pure
(SlackBuilderT f) <*> (SlackBuilderT x) = SlackBuilderT $ f <*> x
instance Monad SlackBuilderT
where
return = pure
(SlackBuilderT x) >>= f = SlackBuilderT $ x >>= runSlackBuilderT . f
instance MonadIO SlackBuilderT
where
liftIO = SlackBuilderT . liftIO
instance MonadThrow SlackBuilderT
where
throwM = SlackBuilderT . throwM
instance MonadCatch SlackBuilderT
where
catch (SlackBuilderT action) handler =
SlackBuilderT $ catch action $ runSlackBuilderT . handler
|
