Skip to content

Commit

Permalink
Util methods to parse ~, $HOME, etc. from config files
Browse files Browse the repository at this point in the history
  • Loading branch information
samtay committed Dec 13, 2016
1 parent 27e877e commit 6137c9d
Show file tree
Hide file tree
Showing 4 changed files with 55 additions and 19 deletions.
10 changes: 5 additions & 5 deletions dockmaster.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 1 addition & 5 deletions src/Dockmaster/Config/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
10 changes: 2 additions & 8 deletions src/Dockmaster/Config/Types.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down
48 changes: 47 additions & 1 deletion src/Dockmaster/Utils.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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"]

0 comments on commit 6137c9d

Please sign in to comment.