Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

version 0.2.1.0: add call stack and useful errors #12

Merged
merged 1 commit into from
Apr 24, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`.
Expand Down
2 changes: 1 addition & 1 deletion bcd-config.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand Down
36 changes: 24 additions & 12 deletions src/System/BCD/Config.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}

module System.BCD.Config
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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.
Expand All @@ -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"
Expand Down