module Imp.Exception.ShowVersion where

import qualified Control.Monad.Catch as Exception
import qualified Data.Version as Version
import qualified Paths_imp as This

data ShowVersion
  = ShowVersion
  deriving (ShowVersion -> ShowVersion -> Bool
(ShowVersion -> ShowVersion -> Bool)
-> (ShowVersion -> ShowVersion -> Bool) -> Eq ShowVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowVersion -> ShowVersion -> Bool
== :: ShowVersion -> ShowVersion -> Bool
$c/= :: ShowVersion -> ShowVersion -> Bool
/= :: ShowVersion -> ShowVersion -> Bool
Eq, Int -> ShowVersion -> ShowS
[ShowVersion] -> ShowS
ShowVersion -> String
(Int -> ShowVersion -> ShowS)
-> (ShowVersion -> String)
-> ([ShowVersion] -> ShowS)
-> Show ShowVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowVersion -> ShowS
showsPrec :: Int -> ShowVersion -> ShowS
$cshow :: ShowVersion -> String
show :: ShowVersion -> String
$cshowList :: [ShowVersion] -> ShowS
showList :: [ShowVersion] -> ShowS
Show)

instance Exception.Exception ShowVersion where
  displayException :: ShowVersion -> String
displayException = String -> ShowVersion -> String
forall a b. a -> b -> a
const (String -> ShowVersion -> String)
-> String -> ShowVersion -> String
forall a b. (a -> b) -> a -> b
$ Version -> String
Version.showVersion Version
This.version

new :: ShowVersion
new :: ShowVersion
new = ShowVersion
ShowVersion