From 6137c9d1ceadbc9415c8248132eab59147d3273f Mon Sep 17 00:00:00 2001
From: Sam Tay <sam.chong.tay@gmail.com>
Date: Mon, 12 Dec 2016 11:38:30 -0500
Subject: [PATCH] Util methods to parse ~, $HOME, etc. from config files

---
 dockmaster.cabal                | 10 +++----
 src/Dockmaster/Config/Parser.hs |  6 +----
 src/Dockmaster/Config/Types.hs  | 10 ++-----
 src/Dockmaster/Utils.hs         | 48 ++++++++++++++++++++++++++++++++-
 4 files changed, 55 insertions(+), 19 deletions(-)

diff --git a/dockmaster.cabal b/dockmaster.cabal
index 895f8d0..fe9ca25 100644
--- a/dockmaster.cabal
+++ b/dockmaster.cabal
@@ -26,15 +26,15 @@ library
                      , Dockmaster.Config.Types
                      , Dockmaster.Utils
   build-depends:       base >= 4.7 && < 5
-                     , yaml
-                     , text
-                     , unordered-containers
-                     , shelly
-                     , text
                      , bytestring
                      , regex-posix
+                     , shelly
+                     , split
                      , system-filepath >= 0.4.7 && < 0.5
                      , system-fileio < 0.4
+                     , text
+                     , unordered-containers
+                     , yaml
   default-language:    Haskell2010
 
 executable dm
diff --git a/src/Dockmaster/Config/Parser.hs b/src/Dockmaster/Config/Parser.hs
index 4e68c14..35b2ae4 100644
--- a/src/Dockmaster/Config/Parser.hs
+++ b/src/Dockmaster/Config/Parser.hs
@@ -17,7 +17,7 @@ module Dockmaster.Config.Parser
 
 -- Local modules
 import Dockmaster.Config.Types
-import Dockmaster.Utils (eitherWrap, testM)
+import Dockmaster.Utils (eitherWrap, testM, getHomeDirectory)
 
 -- External modules
 import Data.Yaml
@@ -120,10 +120,6 @@ tryPath dir = do
 workDirNotFound :: Either T.Text b
 workDirNotFound = Left "dockmaster.yml file not found"
 
--- | Get home directory (in Sh)
-getHomeDirectory :: Sh FilePath
-getHomeDirectory = liftIO F.getHomeDirectory
-
 -- | Convenience method to append filepaths when one is wrapped in a monad
 infixr 4 </>>=
 (</>>=) :: (Monad m) => m FilePath -> FilePath -> m FilePath
diff --git a/src/Dockmaster/Config/Types.hs b/src/Dockmaster/Config/Types.hs
index 04a0bb4..d1bdcb4 100644
--- a/src/Dockmaster/Config/Types.hs
+++ b/src/Dockmaster/Config/Types.hs
@@ -1,18 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Dockmaster.Config.Types where
 
-import Shelly
-import Prelude hiding (FilePath)
 import Data.Yaml
 import Control.Applicative
+import Data.Text as T
 
 -- | 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
+data Config = Config { dmcPaths :: [T.Text] }
 
 -- | Instance to parse dockmaster configuration file
 instance FromJSON Config where
diff --git a/src/Dockmaster/Utils.hs b/src/Dockmaster/Utils.hs
index bf33d2e..d2ccc48 100644
--- a/src/Dockmaster/Utils.hs
+++ b/src/Dockmaster/Utils.hs
@@ -1,8 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 module Dockmaster.Utils
-  ( eitherWrap
+  (
+  -- * Utility methods for common types
+    eitherWrap
   , testM
+  -- * Sh and FilePath utils
+  , getHomeDirectory
+  , parsePath
   ) where
 
+import Shelly
+import Prelude hiding (FilePath)
+import qualified Filesystem.Path.CurrentOS as FP
+import qualified Filesystem as F
+import qualified Data.Text as T
+default (T.Text)
+
 -- | Basically fmap over Either, but allow two functions for each L/R side
 --
 -- Used for text packing on the error
@@ -18,3 +33,34 @@ testM predM mx = do
   test <- mx >>= predM
   x <- mx
   return $ if test then Just x else Nothing
+
+-- | Accepts a path as 'Text' and returns a 'FilePath' path but with
+-- @~@ and @$HOME@ replaced with user home directory
+-- @$DOCKMASTER_HOME@ replaced with either env variable value
+-- or defaults to @~/.dockmaster@
+parsePath :: T.Text -> Sh FilePath
+parsePath path = do
+  home   <- getHomeDirectory >>= toText
+  dmHome <- getDmHomeDirectory >>= toText
+  let replace         = foldr (.) id $ map (\(old,new) -> T.replace old new) dirReplacements
+      dirReplacements = [ ("~", home)
+                        , ("$HOME", home)
+                        , ("$DOCKMASTER_HOME", dmHome) ]
+   in (return . fromText . replace) path
+
+-- | Convert 'FilePath' to 'Text' within 'Sh', exits on failure to convert
+toText :: FilePath -> Sh T.Text
+toText fp = case FP.toText fp of
+    Left err   -> errorExit err
+    Right path -> return path
+
+-- | Get home directory (in Sh)
+getHomeDirectory :: Sh FilePath
+getHomeDirectory = liftIO F.getHomeDirectory
+
+-- | Get DM home directory (in Sh)
+-- TODO !!!
+getDmHomeDirectory :: Sh FilePath
+getDmHomeDirectory = do
+  home <- getHomeDirectory
+  return $ FP.concat [home, fromText ".dockmaster"]