show-please (empty) → 0.3

raw patch · 3 files changed

+132/−0 lines, 3 filesdep +basedep +mtldep +parsecsetup-changed

Dependencies added: base, mtl, parsec, template-haskell

Files

Debug/Show.hs +108/−0
Setup.hs +5/−0
show-please.cabal +19/−0

+ Debug/Show.hs view

@@ -0,0 +1,108 @@+-- | A wrapper type and associated Show instances that generate+-- correct haskell code, especially for exception types.++{-# LANGUAGE FlexibleInstances #-}++module Debug.Show (V(V)) where++import Control.Exception+import Data.Maybe+import Foreign.C.Types+import GHC.Base+import GHC.IO.Exception+import GHC.IO.Handle+import GHC.Show+import Text.Parsec.Error+import Text.Parsec.Pos++newtype V a = V a++instance Show (V IOException) where+    show (V e) =+        "IOError {" +++          "ioe_handle = " ++ show (ioe_handle e) ++ ", " +++          "ioe_type = " ++ show (V (ioe_type e)) ++ ", " +++          "ioe_location = " ++ show (ioe_location e) ++ ", " +++          "ioe_description = " ++ show (ioe_description e) ++ ", " +++          "ioe_errno = " ++ show (ioe_errno e) ++ ", " +++          "ioe_filename = " ++ show (ioe_filename e) ++ "}"++instance Show (V IOErrorType) where+    show (V AlreadyExists) = "AlreadyExists"+    show (V NoSuchThing) = "NoSuchThing"+    show (V ResourceBusy) = "ResourceBusy"+    show (V ResourceExhausted) = "ResourceExhausted"+    show (V EOF) = "EOF"+    show (V IllegalOperation) = "IllegalOperation"+    show (V PermissionDenied) = "PermissionDenied"+    show (V UserError) = "UserError"+    show (V UnsatisfiedConstraints) = "UnsatisfiedConstraints"+    show (V SystemError) = "SystemError"+    show (V ProtocolError) = "ProtocolError"+    show (V OtherError) = "OtherError"+    show (V InvalidArgument) = "InvalidArgument"+    show (V InappropriateType) = "InappropriateType"+    show (V HardwareFault) = "HardwareFault"+    show (V UnsupportedOperation) = "UnsupportedOperation"+    show (V TimeExpired) = "TimeExpired"+    show (V ResourceVanished) = "ResourceVanished"+    show (V Interrupted) = "Interrupted"++instance Show (V Message) where+    show (V (SysUnExpect s)) = "SysUnExpect " ++ show s+    show (V (UnExpect s)) = "UnExpect " ++ show s+    show (V (Expect s)) = "Expect " ++ show s+    show (V (Message s)) = "Message " ++ show s++instance Show (V SourcePos) where+    show (V pos) =+        "(newPos " ++ show (sourceName pos) ++ " " ++ show (sourceLine pos) ++ " " ++ show (sourceColumn pos) ++ ")"++instance Show (V SomeException) where+    show (V e) =+        "toException (" +++            (maybeFrom (fmap ((++ " :: ArithException") . show . V) (fromException e :: Maybe ArithException)) $+             maybeFrom (fmap ((++ " :: ArrayException") . show . V) (fromException e :: Maybe ArrayException)) $+             maybeFrom (fmap ((++ " :: AssertionFailed") . show . V) (fromException e :: Maybe AssertionFailed)) $+             maybeFrom (fmap ((++ " :: AsyncException") . show . V) (fromException e :: Maybe AsyncException)) $+             maybeFrom (fmap ((++ " :: BlockedIndefinitelyOnMVar") . show . V) (fromException e :: Maybe BlockedIndefinitelyOnMVar)) $+             maybeFrom (fmap ((++ " :: BlockedIndefinitelyOnSTM") . show . V) (fromException e :: Maybe BlockedIndefinitelyOnSTM)) $+             maybeFrom (fmap ((++ " :: Deadlock") . show . V) (fromException e :: Maybe Deadlock)) $+             -- maybeFrom (fmap ((++ " :: Dynamic") . show . V) (fromException e :: Maybe Dynamic)) $+             maybeFrom (fmap ((++ " :: ErrorCall") . show . V) (fromException e :: Maybe ErrorCall)) $+             maybeFrom (fmap ((++ " :: ExitCode") . show . V) (fromException e :: Maybe ExitCode)) $+             maybeFrom (fmap ((++ " :: IOException") . show . V) (fromException e :: Maybe IOException)) $+             maybeFrom (fmap ((++ " :: NestedAtomically") . show . V) (fromException e :: Maybe NestedAtomically)) $+             maybeFrom (fmap ((++ " :: NoMethodError") . show . V) (fromException e :: Maybe NoMethodError)) $+             maybeFrom (fmap ((++ " :: NonTermination") . show . V) (fromException e :: Maybe NonTermination)) $+             maybeFrom (fmap ((++ " :: PatternMatchFail") . show . V) (fromException e :: Maybe PatternMatchFail)) $+             maybeFrom (fmap ((++ " :: RecConError") . show . V) (fromException e :: Maybe RecConError)) $+             maybeFrom (fmap ((++ " :: RecSelError") . show . V) (fromException e :: Maybe RecSelError)) $+             maybeFrom (fmap ((++ " :: RecUpdError") . show . V) (fromException e :: Maybe RecUpdError)) $+             maybeFrom (fmap ((++ " :: SomeAsyncException") . show . V) (fromException e :: Maybe SomeAsyncException)) $+             ("No Show instance for V " ++ show e ++ ", report this as a bug at https://github.com/seereason/show-please")) ++ ")"++-- I don't know exactly what these do - they may need to be implemented+-- in more detail, but at least we can tell they name of their type now.+instance Show (V ArithException) where show (V e) = "ArithException: " ++ show e+instance Show (V ArrayException) where show (V e) = "ArrayException: " ++ show e+instance Show (V AssertionFailed) where show (V e) = "AssertionFailed: " ++ show e+instance Show (V AsyncException) where show (V e) = "AsyncException: " ++ show e+instance Show (V BlockedIndefinitelyOnMVar) where show (V e) = "BlockedIndefinitelyOnMVar: " ++ show e+instance Show (V BlockedIndefinitelyOnSTM) where show (V e) = "BlockedIndefinitelyOnSTM: " ++ show e+instance Show (V Deadlock) where show (V e) = "Deadlock: " ++ show e+-- instance Show (V Dynamic) where show (V e) = "Dynamic: " ++ show e+instance Show (V ErrorCall) where show (V (ErrorCall s)) = "ErrorCall " ++ show s+instance Show (V ExitCode) where show (V e) = "ExitCode: " ++ show e+-- instance Show (V IOException) where show (V e) = "IOException: " ++ show e -- defined above+instance Show (V NestedAtomically) where show (V e) = "NestedAtomically: " ++ show e+instance Show (V NoMethodError) where show (V e) = "NoMethodError: " ++ show e+instance Show (V NonTermination) where show (V e) = "NonTermination: " ++ show e+instance Show (V PatternMatchFail) where show (V e) = "PatternMatchFail: " ++ show e+instance Show (V RecConError) where show (V e) = "RecConError: " ++ show e+instance Show (V RecSelError) where show (V e) = "RecSelError: " ++ show e+instance Show (V RecUpdError) where show (V e) = "RecUpdError: " ++ show e+instance Show (V SomeAsyncException) where show (V e) = "SomeAsyncException: " ++ show e++maybeFrom :: Maybe c -> c -> c+maybeFrom = flip fromMaybe

+ Setup.hs view

@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks simpleUserHooks

+ show-please.cabal view

@@ -0,0 +1,19 @@+Name:           show-please+Version:        0.3+License:        BSD3+Author:         David Fox <dsf@seereason.com>+Category:       debug+Maintainer:     David Fox <dsf@seereason.com>+Homepage:       https://github.com/ddssff/show-please+Build-Type:     Simple+Synopsis:       A wrapper type V with improved Show instances+Description: Provides Show instances for various types whose official+  Show won't Read. This is particularly intended for exception types,+  which can appear unexpectedly and be difficult to track down.+Cabal-Version: >= 1.9++Library+ Build-Depends:+  base >= 4 && < 5, mtl, parsec, template-haskell+ Exposed-Modules:+  Debug.Show