Browse Source

Improve error messages, add a `--verbose' command line option

  * Database migration errors are *slightly* less cryptic

  * New `--verbose, -v' option to enable verbose logging.  Currently
    only used in the database migration code.
master
Peter J. Jones 10 months ago
parent
commit
133c5f6b00
Signed by: Peter Jones <pjones@devalot.com> GPG Key ID: 9DAFAA8D01941E49

+ 8
- 11
lib/Web/Hooks/Personal/Env.hs View File

@@ -1,6 +1,6 @@
1 1
 {-
2 2
 
3
-This file is part of the package personal-webhooks. It is subject to
3
+This file is pais subject to
4 4
 the license terms in the LICENSE file found in the top-level directory
5 5
 of this distribution and at:
6 6
 
@@ -17,13 +17,11 @@ the LICENSE file.
17 17
 module Web.Hooks.Personal.Env
18 18
   ( Env(..)
19 19
   , env
20
-  , die
21 20
   ) where
22 21
 
23 22
 --------------------------------------------------------------------------------
24 23
 -- Library imports:
25
-import Control.Monad.IO.Class (MonadIO, liftIO)
26
-import qualified System.Exit as Exit
24
+import Control.Monad.IO.Class (MonadIO)
27 25
 
28 26
 --------------------------------------------------------------------------------
29 27
 -- Local imports:
@@ -31,25 +29,28 @@ import Web.Hooks.Personal.Config (Config)
31 29
 import qualified Web.Hooks.Personal.Config as Config
32 30
 import Web.Hooks.Personal.Internal.Database.Prim (Database)
33 31
 import qualified Web.Hooks.Personal.Internal.Database.Prim as Database
32
+import Web.Hooks.Personal.Internal.Util.Process (die)
34 33
 
35 34
 --------------------------------------------------------------------------------
36 35
 -- | Everything you need to use this library.
37 36
 data Env = Env
38 37
   { config   :: Config    -- ^ Master configuration.
38
+  , verbose  :: Bool      -- ^ Verbose flag.
39 39
   , database :: Database  -- ^ Database handle.
40 40
   }
41 41
 
42 42
 --------------------------------------------------------------------------------
43 43
 -- | Create an environment.  The optional 'FilePath' is passed along
44 44
 -- to the 'Config.load' function.
45
-env :: (MonadIO m) => Maybe FilePath -> m Env
46
-env path = do
45
+env :: (MonadIO m) => Maybe FilePath -> Bool -> m Env
46
+env path vflag = do
47 47
     c <- loadCfg
48 48
     d <- Database.database (Config.configDatabase c)
49 49
 
50
-    Database.migrate d False
50
+    Database.migrate d vflag
51 51
 
52 52
     return Env { config   = c
53
+               , verbose  = vflag
53 54
                , database = d
54 55
                }
55 56
   where
@@ -59,8 +60,3 @@ env path = do
59 60
       case c of
60 61
         Left e   -> die e
61 62
         Right c' -> return c'
62
-
63
---------------------------------------------------------------------------------
64
-die :: (MonadIO m) => String -> m a
65
-die = liftIO . Exit.die . ("ERROR: " ++)

+ 2
- 2
lib/Web/Hooks/Personal/Internal/Database/Prim.hs View File

@@ -38,7 +38,6 @@ import qualified Data.Text.Encoding as Text
38 38
 import Database.PostgreSQL.Simple (Connection)
39 39
 import qualified Database.PostgreSQL.Simple as PostgreSQL
40 40
 import qualified Opaleye
41
-import System.Exit (die)
42 41
 import System.FilePath ((</>))
43 42
 
44 43
 --------------------------------------------------------------------------------
@@ -53,6 +52,7 @@ import Database.PostgreSQL.Simple.Migration ( MigrationCommand(..)
53 52
 -- Local Imports:
54 53
 import Paths_personal_webhooks (getDataDir)
55 54
 import Web.Hooks.Personal.Internal.Database.Config
55
+import Web.Hooks.Personal.Internal.Util.Process (die)
56 56
 
57 57
 --------------------------------------------------------------------------------
58 58
 -- | A database handle.
@@ -140,4 +140,4 @@ migrate d verbose = withConnection d go
140 140
 
141 141
       case result of
142 142
         MigrationSuccess -> return ()
143
-        MigrationError e -> die e
143
+        MigrationError e -> die ("database migration failed: " ++ e)

+ 27
- 0
lib/Web/Hooks/Personal/Internal/Util/Process.hs View File

@@ -0,0 +1,27 @@
1
+{-
2
+
3
+This file is part of the package personal-webhooks. It is subject to
4
+the license terms in the LICENSE file found in the top-level directory
5
+of this distribution and at:
6
+
7
+  git://git.devalot.com/personal-webhooks.git
8
+
9
+No part of this package, including this file, may be copied, modified,
10
+propagated, or distributed except according to the terms contained in
11
+the LICENSE file.
12
+
13
+-}
14
+
15
+--------------------------------------------------------------------------------
16
+module Web.Hooks.Personal.Internal.Util.Process
17
+  ( die
18
+  ) where
19
+
20
+--------------------------------------------------------------------------------
21
+import qualified System.Exit as Exit
22
+import Control.Monad.IO.Class (MonadIO, liftIO)
23
+
24
+--------------------------------------------------------------------------------
25
+-- | Exit the current process with an error message.
26
+die :: (MonadIO m) => String -> m a
27
+die = liftIO . Exit.die . ("ERROR: " ++)

+ 2
- 0
personal-webhooks.cabal View File

@@ -64,6 +64,8 @@ library
64 64
       -- Web.Hooks.Personal.Internal.Request
65 65
         Web.Hooks.Personal.Internal.Request.Config
66 66
         Web.Hooks.Personal.Internal.Request.Prim
67
+      -- Web.Hooks.Personal.Internal.Util
68
+        Web.Hooks.Personal.Internal.Util.Process
67 69
 
68 70
   other-modules:
69 71
     Paths_personal_webhooks

+ 8
- 1
src/Main.hs View File

@@ -43,6 +43,8 @@ data Options = Options
43 43
   { optionConfigFile :: Maybe FilePath
44 44
     -- ^ Alternate configuration file to load.
45 45
 
46
+  , optionVerbose :: Bool
47
+
46 48
   , optionCommand :: Command
47 49
     -- ^ Which subcommand to run.
48 50
   }
@@ -60,6 +62,11 @@ parser =
60 62
                      , help "Load FILE as an alternate config file"
61 63
                      ]))
62 64
 
65
+    <*> switch (mconcat [ long "verbose"
66
+                        , short 'v'
67
+                        , help "Enable verbose logging"
68
+                        ])
69
+
63 70
     <*> subparser (mconcat [ createCommand
64 71
                            , listCommand
65 72
                            , runCommand
@@ -88,7 +95,7 @@ parser =
88 95
 main :: IO ()
89 96
 main = do
90 97
   options <- execParser $ info (parser <**> helper) idm
91
-  env <- Env.env (optionConfigFile options)
98
+  env <- Env.env (optionConfigFile options) (optionVerbose options)
92 99
 
93 100
   flip runReaderT env $
94 101
     case optionCommand options of

+ 3
- 2
src/UI/Run.hs View File

@@ -39,6 +39,7 @@ import Web.Hooks.Personal.Env (Env)
39 39
 import qualified Web.Hooks.Personal.Env as Env
40 40
 import Web.Hooks.Personal.Hook (Hook)
41 41
 import qualified Web.Hooks.Personal.Hook as Hook
42
+import Web.Hooks.Personal.Internal.Util.Process (die)
42 43
 import Web.Hooks.Personal.Request (Request)
43 44
 import qualified Web.Hooks.Personal.Request as Request
44 45
 
@@ -84,7 +85,7 @@ mkRequest readFrom = do
84 85
            ReadFromStdin    -> L.getContents
85 86
 
86 87
   case Request.fromJSON raw of
87
-    Nothing -> Env.die "failed to parse JSON request data"
88
+    Nothing -> die "failed to parse JSON request data"
88 89
     Just r  -> return r
89 90
 
90 91
 --------------------------------------------------------------------------------
@@ -97,7 +98,7 @@ run Options{..} = do
97 98
     status <- runHooks request hooks
98 99
 
99 100
     when (any (/= Action.Okay) status)
100
-      (Env.die "at least one hook action failed")
101
+      (die "at least one hook action failed")
101 102
 
102 103
   where
103 104
     query = Hook.findBy optionFind

Loading…
Cancel
Save