slackbuilder/lib/SlackBuilder/Trans.hs

{- 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