{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Types.Storage
( StoragePrettyException (..)
) where
import Data.Text
import Stack.Prelude
data StoragePrettyException
= StorageMigrationFailure !Text !(Path Abs File) !SomeException
deriving (Int -> StoragePrettyException -> ShowS
[StoragePrettyException] -> ShowS
StoragePrettyException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoragePrettyException] -> ShowS
$cshowList :: [StoragePrettyException] -> ShowS
show :: StoragePrettyException -> String
$cshow :: StoragePrettyException -> String
showsPrec :: Int -> StoragePrettyException -> ShowS
$cshowsPrec :: Int -> StoragePrettyException -> ShowS
Show, Typeable)
instance Pretty StoragePrettyException where
pretty :: StoragePrettyException -> StyleDoc
pretty (StorageMigrationFailure Text
desc Path Abs File
fp SomeException
ex) =
StyleDoc
"[S-8835]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"Stack could not migrate the the database"
StyleDoc -> StyleDoc -> StyleDoc
<+> Style -> StyleDoc -> StyleDoc
style Style
File (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Text
desc)
StyleDoc -> StyleDoc -> StyleDoc
<+> String -> StyleDoc
flow String
"located at"
StyleDoc -> StyleDoc -> StyleDoc
<+> Style -> StyleDoc -> StyleDoc
style Style
Dir (forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fp)
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"While migrating the database, Stack encountered the error:"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
string String
exMsg
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"Please report this as an issue at"
StyleDoc -> StyleDoc -> StyleDoc
<+> Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> if String
exMsg forall a. Eq a => a -> a -> Bool
== String
winIOGHCRTSMsg
then
String -> StyleDoc
flow String
"This error can be caused by a bug that arises if GHC's \
\'--io-manager=native' RTS option is set using the GHCRTS \
\environment variable. As a workaround try setting the option \
\in the project's Cabal file, Stack's YAML configuration file \
\or at the command line."
else
String -> StyleDoc
flow String
"As a workaround you may delete the database. This \
\will cause the database to be recreated."
where
exMsg :: String
exMsg = forall e. Exception e => e -> String
displayException SomeException
ex
winIOGHCRTSMsg :: String
winIOGHCRTSMsg =
String
"\\\\.\\NUL: hDuplicateTo: illegal operation (handles are incompatible)"
instance Exception StoragePrettyException