1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
-- | Commandline options tools. Designed to be imported as @qualified@.
module Hbro.Options (
CliOptions(),
OptionsReader(..),
startURI,
socketPath,
help,
quiet,
uIFile,
verbose,
version,
vanilla,
recompile,
denyReconf,
forceReconf,
dyreDebug,
usage,
get,
getStartURI,
getSocketURI)
where
-- {{{ Imports
import Hbro.Util
import Control.Conditional
import Control.Lens as L hiding((??))
import Control.Monad.Base
import Control.Monad.Reader
import Data.Default
import Data.Functor
import Data.List
import Data.Maybe
import Network.URI as N
import Prelude hiding(log)
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.FilePath
import System.Posix.Process
-- }}}
-- {{{ Types
-- | Available commandline options (cf @hbro -h@).
data CliOptions = CliOptions {
_startURI :: Maybe String,
_socketPath :: Maybe FilePath,
_UIFile :: Maybe FilePath,
_help :: Bool,
_quiet :: Bool,
_verbose :: Bool,
_version :: Bool,
_vanilla :: Bool,
_recompile :: Bool,
_denyReconf :: Bool,
_forceReconf :: Bool,
_dyreDebug :: Bool}
deriving(Eq)
makeLenses ''CliOptions
instance Show CliOptions where
show opts = intercalate " " $ catMaybes [
return . ("URI=" ++) =<< view startURI opts,
return . ("SOCKET=" ++) =<< view socketPath opts,
return . ("UI_FILE=" ++) =<< view uIFile opts,
view help opts ? Just "HELP" ?? Nothing,
view quiet opts ? Just "QUIET" ?? Nothing,
view verbose opts ? Just "VERBOSE" ?? Nothing,
view version opts ? Just "VERSION" ?? Nothing,
view vanilla opts ? Just "VANILLA" ?? Nothing,
view recompile opts ? Just "RECOMPILE" ?? Nothing,
view denyReconf opts ? Just "DENY_RECONFIGURATION" ?? Nothing,
view forceReconf opts ? Just "FORCE_RECONFIGURATION" ?? Nothing,
view dyreDebug opts ? Just "DYRE_DEBUG" ?? Nothing]
instance Default CliOptions where
def = CliOptions {
_startURI = Nothing,
_socketPath = Nothing,
_UIFile = Nothing,
_help = False,
_quiet = False,
_verbose = False,
_version = False,
_vanilla = False,
_recompile = False,
_denyReconf = False,
_forceReconf = False,
_dyreDebug = False}
-- | 'MonadReader' for 'CliOptions'
class OptionsReader m where
readOptions :: Simple Lens CliOptions a -> m a
instance (Monad m) => OptionsReader (ReaderT CliOptions m) where
readOptions l = return . view l =<< ask
instance OptionsReader ((->) CliOptions) where
readOptions l = view l
-- }}}
description :: [OptDescr (CliOptions -> CliOptions)]
description = [
Option ['h'] ["help"] (NoArg (set help True)) "Print this help",
Option ['q'] ["quiet"] (NoArg (set quiet True)) "Do not print any log",
Option ['v'] ["verbose"] (NoArg (set verbose True)) "Print detailed logs",
Option ['V'] ["version"] (NoArg (set version True)) "Print version",
Option ['1'] ["vanilla"] (NoArg (set vanilla True)) "Do not read custom configuration file",
Option ['r'] ["recompile"] (NoArg (set recompile True)) "Only recompile configuration",
Option ['s'] ["socket"] (ReqArg (\v -> set socketPath (Just v)) "PATH") "Where to open IPC socket",
Option ['u'] ["ui"] (ReqArg (\v -> set uIFile (Just v)) "PATH") "Path to UI descriptor (XML file)",
Option [] ["force-reconf"] (NoArg id) "Recompile configuration before starting the program",
Option [] ["deny-reconf"] (NoArg id) "Do not recompile configuration even if it has changed",
Option [] ["dyre-debug"] (NoArg id) "Use './cache/' as the cache directory and ./ as the configuration directory. Useful to debug the program"]
-- | Usage text (cf @hbro -h@)
usage :: String
usage = usageInfo "Usage: hbro [OPTIONS] [URI]" description
-- | Get and parse commandline options
get :: (MonadBase IO m) => m CliOptions
get = io $ do
options <- getOpt' Permute description <$> getArgs
case options of
(opts, input, _, []) -> return $ set startURI ((null $ concat input) ? Nothing ?? Just (concat input)) (foldl (flip id) def opts)
(_, _, _, _) -> return def
-- | Get URI passed in commandline, check whether it is a file path or an internet URI
-- and return the corresponding normalized URI (that is: prefixed with "file://" or "http://")
getStartURI :: (MonadBase IO m, OptionsReader m) => m (Maybe URI)
getStartURI = do
theURI <- readOptions startURI
case theURI of
Just uri -> do
fileURI <- io $ doesFileExist uri
case fileURI of
True -> io getCurrentDirectory >>= return . N.parseURIReference . ("file://" ++) . (</> uri)
_ -> return $ N.parseURIReference uri
_ -> return Nothing
-- | Return socket URI used by this instance
getSocketURI :: (MonadBase IO m, OptionsReader m) => m String
getSocketURI = maybe getDefaultSocketURI (return . ("ipc://" ++)) =<< readOptions socketPath
where
getDefaultSocketURI = do
dir <- io getTemporaryDirectory
pid <- io getProcessID
return $ "ipc://" ++ dir </> "hbro." ++ show pid
|
