From cde78f0864dbf498063e21fc17f02af1abfe6659 Mon Sep 17 00:00:00 2001
From: Maxim Koltsov <kolmax94@gmail.com>
Date: Sat, 24 Apr 2021 17:44:11 +0300
Subject: [PATCH] version 0.2.1.0: add call stack and useful errors

---
 CHANGELOG.md             |  5 +++++
 bcd-config.cabal         |  2 +-
 src/System/BCD/Config.hs | 36 ++++++++++++++++++++++++------------
 3 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index a5b27b4..0ced94b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 ## [Unreleased]
 
+## [0.2.1.0] - 2021-04-24
+### Changed
+- Added `HasCallStack` to unsafe functions;
+- Report actual value and expected type on parse errors.
+
 ## [0.2.0.1] - 2020-03-31
 ### Fixed
 - Compilation with `--pedantic`.
diff --git a/bcd-config.cabal b/bcd-config.cabal
index e5c5a98..aaa3832 100644
--- a/bcd-config.cabal
+++ b/bcd-config.cabal
@@ -1,5 +1,5 @@
 name:           bcd-config
-version:        0.2.0.1
+version:        0.2.1.0
 synopsis:       Library to get config.
 description:    Library to get config to different systems
 homepage:       https://github.com/biocad/bcd-config#readme
diff --git a/src/System/BCD/Config.hs b/src/System/BCD/Config.hs
index 305ff3f..e68c417 100644
--- a/src/System/BCD/Config.hs
+++ b/src/System/BCD/Config.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module System.BCD.Config
@@ -18,8 +20,11 @@ import           Data.List              (find, isPrefixOf)
 import           Data.Maybe             (fromJust)
 import           Data.Text              as T (Text, pack)
 import           Data.Text.IO           (readFile)
+import           GHC.Stack              (HasCallStack)
 import           Prelude                hiding (readFile)
 import           System.Environment     (getArgs, lookupEnv)
+import           Text.Read              (readMaybe)
+import           Type.Reflection        (Typeable, typeRep)
 --
 -------------------------------------------------------------------------------
 -- dotenv
@@ -28,33 +33,40 @@ import           System.Environment     (getArgs, lookupEnv)
 -- | Describes possibility to read something from dotenv configuration.
 --
 class FromDotenv a where
-  fromDotenv :: MonadIO m => m a
+  fromDotenv :: (HasCallStack, MonadIO m) => m a
 
 loadDotenv :: MonadIO m => m ()
 loadDotenv = liftIO $ void $ loadFile defaultConfig
 
-class GetEnv a where
-  getEnv :: MonadIO m => String -> m a
+class Typeable a => GetEnv a where
+  getEnv :: (HasCallStack, MonadIO m) => String -> m a
   getEnv key = do
       valueM <- liftIO $ lookupEnv key
-      maybe (error $ "bcd-config: could not find environment <" <> key <> ">") (pure . convert) valueM
+      case valueM of
+        Nothing -> error $ "bcd-config: could not find environment <" <> key <> ">"
+        Just val -> case convertSafe val of
+          Nothing -> error $ "bcd-config: could not parse environment <" <> key <> "> = <" <> val <> ">" <> " as type " <> show (typeRep @a)
+          Just a -> return a
 
-  convert :: String -> a
+  convert :: HasCallStack => String -> a
+  convert = fromJust . convertSafe
+
+  convertSafe :: HasCallStack => String -> Maybe a
 
 instance GetEnv String where
-  convert = id
+  convertSafe = Just
 
 instance GetEnv Text where
-  convert = T.pack
+  convertSafe = Just . T.pack
 
 instance GetEnv Int where
-  convert = read
+  convertSafe = readMaybe
 
 instance GetEnv Float where
-  convert = read
+  convertSafe = readMaybe
 
 instance GetEnv Bool where
-  convert = read
+  convertSafe = readMaybe
 
 -------------------------------------------------------------------------------
 -- config.json
@@ -63,7 +75,7 @@ instance GetEnv Bool where
 -- | class 'FromJsonConfig' describes possibility to read something from configutaion.
 --
 class FromJsonConfig a where
-  fromJsonConfig :: MonadIO m => m a
+  fromJsonConfig :: (HasCallStack, MonadIO m) => m a
 
 {-|
   The 'getConfig' function returns 'Text' in 'IO' monad with content of JSON file with config.
@@ -76,7 +88,7 @@ class FromJsonConfig a where
   @
   By default it is looking for @config.json@ in current directory.
 -}
-getConfigText :: MonadIO m => m Text
+getConfigText :: (HasCallStack, MonadIO m) => m Text
 getConfigText = do
     args <- liftIO getArgs
     let path = fromJust $ findLong args <|> findShort args <|> Just "config.json"