93 lines
3.3 KiB
Haskell
93 lines
3.3 KiB
Haskell
{- 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.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
|
|
|
|
data SlackBuilderException
|
|
= UpdaterNotFound Text
|
|
| HttpsUrlExpected URI
|
|
| LzmaDecompressionFailed Lzma.LzmaRet
|
|
deriving Show
|
|
|
|
instance Exception SlackBuilderException
|
|
where
|
|
displayException (UpdaterNotFound updateName) = Text.unpack
|
|
$ Text.concat ["Requested package \"", updateName, "\" was not found"]
|
|
displayException (HttpsUrlExpected 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"
|
|
|
|
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
|