Skip to content

Commit

Permalink
Add global config file support
Browse files Browse the repository at this point in the history
- Types for config.yml
- Location resolution for config.yml
  • Loading branch information
samtay committed Dec 13, 2016
1 parent 6768897 commit af7ad4c
Show file tree
Hide file tree
Showing 5 changed files with 90 additions and 4 deletions.
3 changes: 3 additions & 0 deletions dockmaster.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,11 @@ library
hs-source-dirs: src
exposed-modules: Dockmaster
, Dockmaster.Types
, Dockmaster.Config.Types
other-modules: Dockmaster.Locator
, Dockmaster.Parser
, Dockmaster.Config.Parser
, Dockmaster.Utils
build-depends: base >= 4.7 && < 5
, yaml
, text
Expand Down
50 changes: 50 additions & 0 deletions src/Dockmaster/Config/Parser.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Dockmaster.Config.Parser
( config
, baseConfig
) where

-- Local modules
import Dockmaster.Config.Types
import Dockmaster.Utils (eitherWrap, testM)

-- External modules
import Data.Yaml
import qualified Data.ByteString as BS
import Shelly
import Prelude hiding (FilePath)
import qualified Data.Text as T
import Data.Monoid ((<>), First(..))
import Control.Monad (liftM)
default (T.Text)

-- | Get global dockmaster config
-- If config.yml fails to parse, returns Left error
-- If config.yml is not found, returns Right baseConfig (default configuration)
config :: Sh (Either T.Text Config)
config = do
mPath <- resolvePath
case mPath of
Nothing -> return $ Right baseConfig
(Just path) -> do
contents <- readBinary path
return $
eitherWrap T.pack id (decodeEither contents :: Either String Config)

-- | Resolves path to dockmaster config.yml in the following order of precedence:
-- - DOCKMASTER_CONFIG environment variable
-- - $HOME/.dockmaster/config.yml
-- - /etc/dockmaster/config.yml
resolvePath :: Sh (Maybe FilePath)
resolvePath = do
envPathT <- get_env "DOCKMASTER_CONFIG"
homePath <- testM test_e id $ "$HOME" </> ".dockmaster" </> "config.yml"
etcPath <- testM test_e id $ "/etc" </> "dockmaster" </> "config.yml"
return $
getFirst . mconcat $ map First [envPathT >>= (return . fromText), homePath, etcPath]

-- | Get base config options
baseConfig :: Config
baseConfig = Config { dmcPaths = [] }
21 changes: 21 additions & 0 deletions src/Dockmaster/Config/Types.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
module Dockmaster.Config.Types where

import Shelly
import Prelude hiding (FilePath)
import Data.Yaml
import Control.Applicative

-- | Dockmaster configuration
data Config = Config { dmcPaths :: [FilePath] }

-- | Custom instance to parse strings directly into FilePath
-- TODO ensure this isn't bad. FFP warned me against "orphan instances"...
instance FromJSON FilePath where
parseJSON v = fromText <$> parseJSON v

-- | Instance to parse dockmaster configuration file
instance FromJSON Config where
parseJSON (Object v) = Config
<$> (v .:? "PATHS" .!= [])

7 changes: 3 additions & 4 deletions src/Dockmaster/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,9 @@ module Dockmaster.Parser
dockmasterYml
) where

-- Local modules
import Dockmaster.Utils (eitherWrap)

-- External modules
import Data.Yaml
import Dockmaster.Types
Expand All @@ -21,7 +24,3 @@ dockmasterYml = do
contents <- readBinary "dockmaster.yml"
return $
eitherWrap T.pack id (decodeEither contents :: Either String Dockmaster)

eitherWrap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
eitherWrap f _ (Left a) = Left $ f a
eitherWrap _ g (Right c) = Right $ g c
13 changes: 13 additions & 0 deletions src/Dockmaster/Utils.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
module Dockmaster.Utils
( eitherWrap
, testM
) where

eitherWrap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
eitherWrap f _ (Left a) = Left $ f a
eitherWrap _ g (Right c) = Right $ g c

testM :: (Monad m) => (a -> m Bool) -> (a -> b) -> a -> m (Maybe b)
testM predM f x = do
test <- predM x
return $ if test then Just (f x) else Nothing

0 comments on commit af7ad4c

Please sign in to comment.