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 1 year 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 @@
{-

This file is part of the package personal-webhooks. It is subject to
This file is pais subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at:

@@ -17,13 +17,11 @@ the LICENSE file.
module Web.Hooks.Personal.Env
( Env(..)
, env
, die
) where

--------------------------------------------------------------------------------
-- Library imports:
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified System.Exit as Exit
import Control.Monad.IO.Class (MonadIO)

--------------------------------------------------------------------------------
-- Local imports:
@@ -31,25 +29,28 @@ import Web.Hooks.Personal.Config (Config)
import qualified Web.Hooks.Personal.Config as Config
import Web.Hooks.Personal.Internal.Database.Prim (Database)
import qualified Web.Hooks.Personal.Internal.Database.Prim as Database
import Web.Hooks.Personal.Internal.Util.Process (die)

--------------------------------------------------------------------------------
-- | Everything you need to use this library.
data Env = Env
{ config :: Config -- ^ Master configuration.
, verbose :: Bool -- ^ Verbose flag.
, database :: Database -- ^ Database handle.
}

--------------------------------------------------------------------------------
-- | Create an environment. The optional 'FilePath' is passed along
-- to the 'Config.load' function.
env :: (MonadIO m) => Maybe FilePath -> m Env
env path = do
env :: (MonadIO m) => Maybe FilePath -> Bool -> m Env
env path vflag = do
c <- loadCfg
d <- Database.database (Config.configDatabase c)

Database.migrate d False
Database.migrate d vflag

return Env { config = c
, verbose = vflag
, database = d
}
where
@@ -59,8 +60,3 @@ env path = do
case c of
Left e -> die e
Right c' -> return c'

--------------------------------------------------------------------------------
die :: (MonadIO m) => String -> m a
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
import Database.PostgreSQL.Simple (Connection)
import qualified Database.PostgreSQL.Simple as PostgreSQL
import qualified Opaleye
import System.Exit (die)
import System.FilePath ((</>))

--------------------------------------------------------------------------------
@@ -53,6 +52,7 @@ import Database.PostgreSQL.Simple.Migration ( MigrationCommand(..)
-- Local Imports:
import Paths_personal_webhooks (getDataDir)
import Web.Hooks.Personal.Internal.Database.Config
import Web.Hooks.Personal.Internal.Util.Process (die)

--------------------------------------------------------------------------------
-- | A database handle.
@@ -140,4 +140,4 @@ migrate d verbose = withConnection d go

case result of
MigrationSuccess -> return ()
MigrationError e -> die e
MigrationError e -> die ("database migration failed: " ++ e)

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

@@ -0,0 +1,27 @@
{-

This file is part of the package personal-webhooks. It is subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at:

git://git.devalot.com/personal-webhooks.git

No part of this package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Web.Hooks.Personal.Internal.Util.Process
( die
) where

--------------------------------------------------------------------------------
import qualified System.Exit as Exit
import Control.Monad.IO.Class (MonadIO, liftIO)

--------------------------------------------------------------------------------
-- | Exit the current process with an error message.
die :: (MonadIO m) => String -> m a
die = liftIO . Exit.die . ("ERROR: " ++)

+ 2
- 0
personal-webhooks.cabal View File

@@ -64,6 +64,8 @@ library
-- Web.Hooks.Personal.Internal.Request
Web.Hooks.Personal.Internal.Request.Config
Web.Hooks.Personal.Internal.Request.Prim
-- Web.Hooks.Personal.Internal.Util
Web.Hooks.Personal.Internal.Util.Process

other-modules:
Paths_personal_webhooks

+ 8
- 1
src/Main.hs View File

@@ -43,6 +43,8 @@ data Options = Options
{ optionConfigFile :: Maybe FilePath
-- ^ Alternate configuration file to load.

, optionVerbose :: Bool

, optionCommand :: Command
-- ^ Which subcommand to run.
}
@@ -60,6 +62,11 @@ parser =
, help "Load FILE as an alternate config file"
]))

<*> switch (mconcat [ long "verbose"
, short 'v'
, help "Enable verbose logging"
])

<*> subparser (mconcat [ createCommand
, listCommand
, runCommand
@@ -88,7 +95,7 @@ parser =
main :: IO ()
main = do
options <- execParser $ info (parser <**> helper) idm
env <- Env.env (optionConfigFile options)
env <- Env.env (optionConfigFile options) (optionVerbose options)

flip runReaderT env $
case optionCommand options of

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

@@ -39,6 +39,7 @@ import Web.Hooks.Personal.Env (Env)
import qualified Web.Hooks.Personal.Env as Env
import Web.Hooks.Personal.Hook (Hook)
import qualified Web.Hooks.Personal.Hook as Hook
import Web.Hooks.Personal.Internal.Util.Process (die)
import Web.Hooks.Personal.Request (Request)
import qualified Web.Hooks.Personal.Request as Request

@@ -84,7 +85,7 @@ mkRequest readFrom = do
ReadFromStdin -> L.getContents

case Request.fromJSON raw of
Nothing -> Env.die "failed to parse JSON request data"
Nothing -> die "failed to parse JSON request data"
Just r -> return r

--------------------------------------------------------------------------------
@@ -97,7 +98,7 @@ run Options{..} = do
status <- runHooks request hooks

when (any (/= Action.Okay) status)
(Env.die "at least one hook action failed")
(die "at least one hook action failed")

where
query = Hook.findBy optionFind

Loading…
Cancel
Save