From af7ad4cafd1c83f82cc3eef05d9d7b0434d17f82 Mon Sep 17 00:00:00 2001
From: Sam Tay <sam.chong.tay@gmail.com>
Date: Wed, 7 Dec 2016 21:57:50 -0500
Subject: [PATCH] Add global config file support

- Types for config.yml
- Location resolution for config.yml
---
 dockmaster.cabal                |  3 ++
 src/Dockmaster/Config/Parser.hs | 50 +++++++++++++++++++++++++++++++++
 src/Dockmaster/Config/Types.hs  | 21 ++++++++++++++
 src/Dockmaster/Parser.hs        |  7 ++---
 src/Dockmaster/Utils.hs         | 13 +++++++++
 5 files changed, 90 insertions(+), 4 deletions(-)
 create mode 100644 src/Dockmaster/Config/Parser.hs
 create mode 100644 src/Dockmaster/Config/Types.hs
 create mode 100644 src/Dockmaster/Utils.hs

diff --git a/dockmaster.cabal b/dockmaster.cabal
index 97c6c44..6ac5630 100644
--- a/dockmaster.cabal
+++ b/dockmaster.cabal
@@ -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
diff --git a/src/Dockmaster/Config/Parser.hs b/src/Dockmaster/Config/Parser.hs
new file mode 100644
index 0000000..a5f7229
--- /dev/null
+++ b/src/Dockmaster/Config/Parser.hs
@@ -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 = [] }
diff --git a/src/Dockmaster/Config/Types.hs b/src/Dockmaster/Config/Types.hs
new file mode 100644
index 0000000..04a0bb4
--- /dev/null
+++ b/src/Dockmaster/Config/Types.hs
@@ -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" .!= [])
+
diff --git a/src/Dockmaster/Parser.hs b/src/Dockmaster/Parser.hs
index 7f749e7..0d55373 100644
--- a/src/Dockmaster/Parser.hs
+++ b/src/Dockmaster/Parser.hs
@@ -6,6 +6,9 @@ module Dockmaster.Parser
   dockmasterYml
   ) where
 
+-- Local modules
+import Dockmaster.Utils (eitherWrap)
+
 -- External modules
 import Data.Yaml
 import Dockmaster.Types
@@ -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
diff --git a/src/Dockmaster/Utils.hs b/src/Dockmaster/Utils.hs
new file mode 100644
index 0000000..e208804
--- /dev/null
+++ b/src/Dockmaster/Utils.hs
@@ -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