f/extensible errors

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2014-2015, Matvey Aksenov
+Copyright (c) 2014-2016, Matvey Aksenov
 
 All rights reserved.
 

default.nix

@@ -1,2 +1,2 @@
-{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7101" }:
+{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7102" }:
 nixpkgs.pkgs.haskell.packages.${compiler}.callPackage ./package.nix {}

envparse.cabal

@@ -78,6 +78,7 @@ library
   exposed-modules:
     Env
   other-modules:
+    Env.Error
     Env.Free
     Env.Help
     Env.Parse

example/CustomError.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE NamedFieldPuns #-}
+-- | Greetings for $NAMES
+--
+-- @
+-- % NAME=a5579150 COUNT=0 runhaskell -isrc example/Main.hs
+-- ...
+-- COUNT must be > 0, but is 0
+-- % NAME=a5579150 COUNT=3 runhaskell -isrc example/Main.hs
+-- Hello, foo!
+-- Hello, foo!
+-- Hello, foo!
+module Main (main) where
+
+import           Control.Monad (replicateM_)
+import           Env
+import qualified Env.Error as Error
+import           Text.Printf (printf)
+
+
+data Hello = Hello { name :: String, count :: Int }
+
+main :: IO ()
+main = do
+  Hello {name, count} <- hello
+  replicateM_ count $
+    putStrLn ("Hello, " ++ name ++ "!")
+
+hello :: IO Hello
+hello = Env.parse (header "envparse example" . handleError customErrorHandler) $ Hello
+  <$> var nonempty            "NAME"  (help "Target for the greeting")
+  <*> var (positive <=< auto) "COUNT" (help "How many times to greet?")
+
+customErrorHandler :: ErrorHandler CustomError
+customErrorHandler name err =
+  case err of
+    NonPositive n ->
+      Just (printf "  %s must be > 0, but is %d" name n)
+    _ ->
+      defaultErrorHandler name err
+
+positive :: Int -> Either CustomError Int
+positive n
+  | n <= 0 =
+    Left (NonPositive n)
+  | otherwise =
+    pure n
+
+data CustomError
+  = NonPositive Int
+  | EnvError Error
+
+-- * Boilerplate
+
+instance AsUnset CustomError where
+  unset =
+    EnvError Error.unset
+  tryUnset err =
+    case err of
+      EnvError err' -> Error.tryUnset err'
+      _ -> Nothing
+
+instance Error.AsEmpty CustomError where
+  empty =
+    EnvError Error.empty
+  tryEmpty err =
+    case err of
+      EnvError err' -> Error.tryEmpty err'
+      _ -> Nothing
+
+instance Error.AsUnread CustomError where
+  unread =
+    EnvError . Error.unread
+  tryUnread err =
+    case err of
+      EnvError err' -> Error.tryUnread err'
+      _ -> Nothing

example/Main.hs

@@ -15,10 +15,9 @@ import Env
 
 data Hello = Hello { name :: String, quiet :: Bool }
 
-
 main :: IO ()
 main = do
-  Hello { name, quiet } <- hello
+  Hello {name, quiet} <- hello
   unless quiet $
     putStrLn ("Hello, " ++ name ++ "!")
 

shell.nix

@@ -1,17 +1,16 @@
-{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7101" }: let
+{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7102" }: let
   inherit (nixpkgs) pkgs;
   ghc = pkgs.haskell.packages.${compiler}.ghcWithPackages(ps: [
-    ps.hdevtools ps.doctest ps.hspec-discover
+    ps.hdevtools ps.doctest ps.hspec-discover ps.hlint ps.ghc-mod
   ]);
   cabal-install = pkgs.haskell.packages.${compiler}.cabal-install;
   pkg = (import ./default.nix { inherit nixpkgs compiler; });
 in
   pkgs.stdenv.mkDerivation rec {
     name = pkg.pname;
-    buildInputs = [ ghc cabal-install ] ++ pkg.env.buildInputs;
+    buildInputs = [ ghc cabal-install pkgs.moreutils ] ++ pkg.env.buildInputs;
     shellHook = ''
       ${pkg.env.shellHook}
-      export IN_WHICH_NIX_SHELL=${name}
-      cabal --no-require-sandbox configure --package-db=$NIX_GHC_LIBDIR/package.conf.d --enable-tests
+      chronic cabal configure --package-db=$NIX_GHC_LIBDIR/package.conf.d --enable-tests
     '';
   }

src/Env.hs

@@ -47,10 +47,13 @@ module Env
   , parseOr
   , Parser
   , Mod
-  , Info
-  , header
-  , desc
-  , footer
+  , Help.Info
+  , Help.header
+  , Help.desc
+  , Help.footer
+  , Help.handleError
+  , Help.ErrorHandler
+  , Help.defaultErrorHandler
   , prefixed
   , var
   , Var
@@ -65,14 +68,14 @@ module Env
   , Flag
   , HasHelp
   , help
-  , helpDoc
+  , Help.helpDoc
+  , Error(..)
+  , Error.AsUnset(..)
+  , Error.AsEmpty(..)
+  , Error.AsUnread(..)
   -- * Re-exports
   -- $re-exports
-  , pure, (<$>), (<*>), (*>), (<*), optional
-  , empty, (<|>)
-  , (<=<), (>=>)
-  , (<>), mempty, mconcat
-  , asum
+  , optional, (<=<), (>=>), (<>), asum
   -- * Testing
   -- $testing
   , parsePure
@@ -82,15 +85,18 @@ import           Control.Applicative
 import           Control.Monad ((>=>), (<=<))
 import           Data.Foldable (asum)
 #if __GLASGOW_HASKELL__ < 710
-import           Data.Monoid (Monoid(..))
-#endif
+import           Data.Monoid (Monoid(..), (<>))
+#else
 import           Data.Monoid ((<>))
+#endif
 import           System.Environment (getEnvironment)
 import           System.Exit (exitFailure)
 import qualified System.IO as IO
 
-import           Env.Help (helpInfo, helpDoc)
+import qualified Env.Help as Help
 import           Env.Parse
+import           Env.Error (Error)
+import qualified Env.Error as Error
 
 -- $re-exports
 -- External functions that may be useful to the consumer of the library
@@ -99,32 +105,26 @@ import           Env.Parse
 -- Utilities to test—without dabbling in IO—that your parsers do
 -- what you want them to do
 
-
 -- | Parse the environment or die
 --
 -- Prints the help text and exits with @EXIT_FAILURE@ on encountering a parse error.
 --
 -- @
 -- >>> parse ('header' \"env-parse 0.2.0\") ('var' 'str' \"USER\" ('def' \"nobody\"))
 -- @
-parse :: Mod Info a -> Parser a -> IO a
-parse m = fmap (either (\_ -> error "absurd") id) . parseOr die m
+parse :: (Help.Info Error -> Help.Info e) -> Parser e a -> IO a
+parse m =
+  fmap (either (\_ -> error "absurd") id) . parseOr die m
 
 -- | Try to parse the environment
 --
 -- Use this if simply dying on failure (the behavior of 'parse') is inadequate for your needs.
-parseOr :: (String -> IO a) -> Mod Info b -> Parser b -> IO (Either a b)
-parseOr f m p = traverseLeft f . parsePure m p =<< getEnvironment
+parseOr :: (String -> IO a) -> (Help.Info Error -> Help.Info e) -> Parser e b -> IO (Either a b)
+parseOr f g p =
+  traverseLeft (f . Help.helpInfo (g Help.defaultInfo) p) . parsePure p =<< getEnvironment
 
 die :: String -> IO a
 die m = do IO.hPutStrLn IO.stderr m; exitFailure
 
--- | Try to parse a pure environment
-parsePure :: Mod Info a -> Parser a -> [(String, String)] -> Either String a
-parsePure (Mod f) p = mapLeft (helpInfo (f defaultInfo) p) . static p
-
-mapLeft :: (a -> b) -> Either a t -> Either b t
-mapLeft f = either (Left . f) Right
-
 traverseLeft :: Applicative f => (a -> f b) -> Either a t -> f (Either b t)
 traverseLeft f = either (fmap Left . f) (pure . Right)

src/Env/Error.hs

@@ -0,0 +1,64 @@
+-- | This module contains an extensible error infrastructure.
+--
+-- Each kind of errors gets a separate type class which encodes
+-- a 'Prism' (roughly a getter and a constructor). The 'Reader's, then,
+-- have the constraints for precisely the set of errors they can return.
+module Env.Error
+  ( Error(..)
+  , AsUnset(..)
+  , AsEmpty(..)
+  , AsUnread(..)
+  ) where
+
+
+-- | The type of errors returned by @envparse@'s 'Reader's. These fall into 3
+-- categories:
+--
+--   * Variables that are unset in the environment.
+--   * Variables whose value is empty.
+--   * Variables whose value cannot be parsed using the 'Read' instance.
+data Error
+  = UnsetError
+  | EmptyError
+  | UnreadError String
+    deriving (Show, Eq)
+
+-- | The class of types that contain and can be constructed from
+-- the error returned from parsing unset variables.
+class AsUnset e where
+  unset :: e
+  tryUnset :: e -> Maybe ()
+
+instance AsUnset Error where
+  unset = UnsetError
+  tryUnset err =
+    case err of
+      UnsetError -> Just ()
+      _ -> Nothing
+
+-- | The class of types that contain and can be constructed from
+-- the error returned from parsing variables whose value is empty.
+class AsEmpty e where
+  empty :: e
+  tryEmpty :: e -> Maybe ()
+
+instance AsEmpty Error where
+  empty = EmptyError
+  tryEmpty err =
+    case err of
+      EmptyError -> Just ()
+      _ -> Nothing
+
+-- | The class of types that contain and can be constructed from
+-- the error returned from parsing variable whose value cannot
+-- be parsed using the 'Read' instance.
+class AsUnread e where
+  unread :: String -> e
+  tryUnread :: e -> Maybe String
+
+instance AsUnread Error where
+  unread = UnreadError
+  tryUnread err =
+    case err of
+      UnreadError msg -> Just msg
+      _ -> Nothing