fix: trim empty lines from remote file
This commit is contained in:
Mahdi Dibaiee
parent
9fe858ea5a
commit
5b76c2a15d
@ -19,6 +19,8 @@ module System.Serverman ( run
|
||||
|
||||
import Control.Monad.Free
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
run :: Action r -> App r
|
||||
run (Pure r) = return r
|
||||
run (Free (DetectOS next)) = getOS >> run next
|
||||
@ -28,7 +30,7 @@ module System.Serverman ( run
|
||||
|
||||
run (Free (Call service remote next)) = callService service remote >> run next
|
||||
|
||||
run (Free (Remote addrs action next)) = mapM_ (\addr -> runRemotely addr (run action)) addrs >> run next
|
||||
run (Free (Remote addrs action next)) = mapM_ (\addr -> unmountPath addr >> runRemotely addr (run action)) addrs >> run next
|
||||
|
||||
run (Free (FetchRepository next)) = fetchRepo False >> run next
|
||||
run (Free (UpdateRepository next)) = fetchRepo True >> run next
|
||||
|
||||
@ -18,10 +18,10 @@ module System.Serverman.Actions.Call (callService) where
|
||||
import Data.Maybe
|
||||
|
||||
callService :: Service -> Maybe FilePath -> App ()
|
||||
callService s@(Service { name, version }) remote = do
|
||||
callService s@Service { name, version } remote = do
|
||||
done <- progressText $ "running service " ++ show s
|
||||
|
||||
state@(AppState { repositoryURL, helpArg }) <- get
|
||||
state@AppState { repositoryURL, helpArg } <- get
|
||||
put $ state { remoteMode = Nothing }
|
||||
|
||||
dir <- liftIO $ getAppUserDataDirectory "serverman"
|
||||
@ -42,7 +42,7 @@ module System.Serverman.Actions.Call (callService) where
|
||||
|
||||
let finalEnv = map (mergeEnv $ parseKeyValue stackSourceEnv '=') (parseKeyValue stackEnv '=')
|
||||
|
||||
backupEnv <- liftIO $ getEnvironment
|
||||
backupEnv <- liftIO getEnvironment
|
||||
liftIO $ setEnvironment finalEnv
|
||||
|
||||
func <- liftIO $ runInterpreter (getCall include entry)
|
||||
@ -79,7 +79,7 @@ module System.Serverman.Actions.Call (callService) where
|
||||
|
||||
where
|
||||
handleRemote (Just file) action = do
|
||||
list <- liftIO $ map read . lines <$> readFile file
|
||||
list <- liftIO $ map read . filter (not . null) . lines <$> readFile file
|
||||
mapM_ (`runRemotely` action) list
|
||||
handleRemote _ action = action
|
||||
|
||||
@ -92,14 +92,15 @@ module System.Serverman.Actions.Call (callService) where
|
||||
|
||||
getCall :: [FilePath] -> FilePath -> Interpreter (Service -> App ())
|
||||
getCall path entry = do
|
||||
set [searchPath := path]
|
||||
loadModules [entry]
|
||||
setTopLevelModules ["Main"]
|
||||
initializeInterpreter path entry
|
||||
interpret "call" (as :: Service -> App ())
|
||||
|
||||
getHelp :: [FilePath] -> FilePath -> Interpreter (App String)
|
||||
getHelp path entry = do
|
||||
initializeInterpreter path entry
|
||||
interpret "help" (as :: App String)
|
||||
|
||||
initializeInterpreter path entry = do
|
||||
set [searchPath := path]
|
||||
loadModules [entry]
|
||||
setTopLevelModules ["Main"]
|
||||
interpret "help" (as :: App String)
|
||||
|
||||
@ -1,7 +1,8 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
|
||||
module System.Serverman.Actions.Remote ( runRemotely
|
||||
, Address) where
|
||||
, Address
|
||||
, unmountPath) where
|
||||
import System.Serverman.Utils hiding (liftIO)
|
||||
import System.Serverman.Actions.Env
|
||||
import System.Serverman.Log
|
||||
@ -22,8 +23,18 @@ module System.Serverman.Actions.Remote ( runRemotely
|
||||
|
||||
actionDelay = 1000000
|
||||
|
||||
unmountPath :: Address -> App ()
|
||||
unmountPath addr@(Address host port user) = do
|
||||
tmp <- liftIO getTemporaryDirectory
|
||||
|
||||
let path = tmp </> ("serverman@" ++ host)
|
||||
|
||||
execute "fusermount" ["-u", path] "" False
|
||||
return ()
|
||||
|
||||
runRemotely :: Address -> App r -> App ()
|
||||
runRemotely addr@(Address host port user) action = do
|
||||
verbose $ "running action remotely on " ++ show addr
|
||||
done <- progressText $ "connecting to server " ++ show addr
|
||||
|
||||
tmp <- liftIO getTemporaryDirectory
|
||||
@ -58,7 +69,7 @@ module System.Serverman.Actions.Remote ( runRemotely
|
||||
|
||||
result <- execute "sshfs" (p ++ noPassword ++ uid ++ options ++ ["-o", "IdentityFile=" ++ keyPath, smConnection ++ ":/", path]) "" False
|
||||
|
||||
state@(AppState { temps }) <- get
|
||||
state@AppState { temps } <- get
|
||||
put $ state { temps = path:temps }
|
||||
|
||||
return result
|
||||
@ -71,8 +82,7 @@ module System.Serverman.Actions.Remote ( runRemotely
|
||||
case result of
|
||||
Right _ -> do
|
||||
state <- get
|
||||
liftIO $ do
|
||||
threadDelay actionDelay
|
||||
liftIO $ threadDelay actionDelay
|
||||
|
||||
put $ state { remoteMode = Just (servermanAddr, keyPath) }
|
||||
getOS
|
||||
@ -82,10 +92,10 @@ module System.Serverman.Actions.Remote ( runRemotely
|
||||
|
||||
Left e -> do
|
||||
info $ "it seems to be the first time you are using serverman for configuring " ++ show addr
|
||||
write $ "remotely. serverman will create a user, and add it to sudoers file. an ssh key will be created"
|
||||
write $ "and that will be used for connecting to the server from now on"
|
||||
write $ "you will not be prompted for a password to connect to server with"
|
||||
write $ "please enable password authentication temporarily on your server for this step"
|
||||
write "remotely. serverman will create a user, and add it to sudoers file. an ssh key will be created"
|
||||
write "and that will be used for connecting to the server from now on"
|
||||
write "you will not be prompted for a password to connect to server with"
|
||||
write "please enable password authentication temporarily on your server for this step"
|
||||
|
||||
write $ "Enter password for " ++ connection
|
||||
|
||||
@ -94,7 +104,7 @@ module System.Serverman.Actions.Remote ( runRemotely
|
||||
|
||||
done <- progressText $ "setting up serverman user in server " ++ show addr
|
||||
|
||||
execIfMissing keyPath $ execute "ssh-keygen" ["-N", "", "-f", keyPath] "" True >> return ()
|
||||
execIfMissing keyPath $ void $ execute "ssh-keygen" ["-N", "", "-f", keyPath] "" True
|
||||
|
||||
publicKey <- liftIO $ readFile pubPath
|
||||
|
||||
|
||||
@ -25,9 +25,9 @@ module System.Serverman.Log ( verbose
|
||||
|
||||
verbose :: String -> App ()
|
||||
verbose str = do
|
||||
(AppState { verboseMode }) <- get
|
||||
AppState { verboseMode } <- get
|
||||
liftIO $
|
||||
when verboseMode $ do
|
||||
when verboseMode $
|
||||
putStrLn . format . F.gray $ read ("[verbose] " ++ str)
|
||||
|
||||
write :: String -> App ()
|
||||
@ -50,19 +50,15 @@ module System.Serverman.Log ( verbose
|
||||
|
||||
clearLine :: IO ()
|
||||
clearLine = do
|
||||
putStr $ "\ESC[2K\ESC[0;"
|
||||
putStr "\ESC[2K\ESC[0;"
|
||||
hFlush stdout
|
||||
|
||||
backward :: Int -> IO ()
|
||||
backward n = do
|
||||
putStr $ "\ESC[" ++ (show n) ++ "D\ESC[0;"
|
||||
backward n =
|
||||
putStr $ "\ESC[" ++ show n ++ "D\ESC[0;"
|
||||
|
||||
progressText :: String -> App (App ())
|
||||
progressText str = do
|
||||
state <- get
|
||||
p <- progressListener str
|
||||
|
||||
return p
|
||||
progressText = progressListener
|
||||
|
||||
progressCharacters = [". ", ".. ", "...", " ..", " .", " "]
|
||||
progressDelay = 200000
|
||||
@ -85,12 +81,12 @@ module System.Serverman.Log ( verbose
|
||||
|
||||
liftIO $ do
|
||||
backward strLength
|
||||
putStr . format . (light . F.blue) $ read str
|
||||
putStr . format . light . F.blue $ read str
|
||||
hFlush stdout
|
||||
|
||||
return ()
|
||||
|
||||
stop process = do
|
||||
stop process =
|
||||
liftIO $ do
|
||||
cancel process
|
||||
backward strLength
|
||||
|
||||
@ -71,7 +71,7 @@ module System.Serverman.Types ( Service (..)
|
||||
readsPrec _ service = [(Service { name = service }, [])]
|
||||
|
||||
instance Show Service where
|
||||
show (Service { name, version }) =
|
||||
show Service { name, version } =
|
||||
name ++ "@" ++ version
|
||||
|
||||
type Repository = [Service]
|
||||
@ -91,7 +91,7 @@ module System.Serverman.Types ( Service (..)
|
||||
}
|
||||
|
||||
instance Show AppState where
|
||||
show (AppState { remoteMode, repository, repositoryURL, os, arguments, ports, processes, temps, verboseMode }) =
|
||||
show AppState { remoteMode, repository, repositoryURL, os, arguments, ports, processes, temps, verboseMode } =
|
||||
"remote: " ++ show remoteMode ++ "\n" ++
|
||||
"repository:\n" ++
|
||||
" - url: " ++ show repositoryURL ++ "\n" ++
|
||||
|
||||
@ -40,7 +40,6 @@ module System.Serverman.Utils ( App (..)
|
||||
import Data.List
|
||||
import Control.Exception
|
||||
import System.Exit hiding (die)
|
||||
import Data.Maybe
|
||||
import System.Posix.Terminal
|
||||
import System.Posix.IO (stdInput)
|
||||
import Data.Maybe
|
||||
@ -63,7 +62,7 @@ module System.Serverman.Utils ( App (..)
|
||||
-- forward ports declared by `usingPort`
|
||||
liftIO :: IO a -> App a
|
||||
liftIO action = do
|
||||
state@(AppState { remoteMode, ports }) <- get
|
||||
state@AppState { remoteMode, ports } <- get
|
||||
verbose $ "liftIO " ++ show remoteMode ++ ", " ++ show ports
|
||||
|
||||
case remoteMode of
|
||||
@ -73,14 +72,14 @@ module System.Serverman.Utils ( App (..)
|
||||
tmp <- ST.liftIO getTemporaryDirectory
|
||||
let path = tmp </> (user ++ "@" ++ host)
|
||||
|
||||
verbose $ "forwarding ports"
|
||||
verbose "forwarding ports"
|
||||
mapM_ (portForward rm) ports
|
||||
|
||||
verbose $ "chroot directory " ++ path
|
||||
|
||||
catchIOError
|
||||
(fchroot path $ ST.liftIO action)
|
||||
(\e -> err (show e) >> (ST.liftIO $ threadDelay 1000000) >> liftIO action)
|
||||
(\e -> err (show e) >> ST.liftIO (threadDelay 1000000) >> liftIO action)
|
||||
where
|
||||
portForward (Address host port user, key) (source, destination) = do
|
||||
let forward = source ++ ":" ++ host ++ ":" ++ destination
|
||||
@ -89,7 +88,7 @@ module System.Serverman.Utils ( App (..)
|
||||
|
||||
(_, _, _, handle) <- ST.liftIO $ runInteractiveCommand $ "ssh -L " ++ forward ++ " " ++ connection ++ identity
|
||||
|
||||
state@(AppState { processes }) <- get
|
||||
state@AppState { processes } <- get
|
||||
put $ state { processes = handle:processes }
|
||||
return ()
|
||||
|
||||
@ -97,7 +96,7 @@ module System.Serverman.Utils ( App (..)
|
||||
-- this allows connections to ports on a remote server
|
||||
usingPort :: String -> App String
|
||||
usingPort port = do
|
||||
state@(AppState { ports, remoteMode }) <- get
|
||||
state@AppState { ports, remoteMode } <- get
|
||||
|
||||
case remoteMode of
|
||||
Nothing -> return port
|
||||
@ -115,7 +114,7 @@ module System.Serverman.Utils ( App (..)
|
||||
clearPort :: String -> App ()
|
||||
clearPort port = do
|
||||
verbose $ "freed port " ++ port
|
||||
state@(AppState { ports, remoteMode }) <- get
|
||||
state@AppState { ports, remoteMode } <- get
|
||||
let newPorts = filter ((/= port) . fst) ports
|
||||
put $ state { ports = newPorts }
|
||||
return ()
|
||||
@ -177,7 +176,7 @@ module System.Serverman.Utils ( App (..)
|
||||
execIfMissing path action = do
|
||||
exists <- ST.liftIO $ doesPathExist path
|
||||
|
||||
when (not exists) action
|
||||
unless exists action
|
||||
|
||||
-- execute an action if a path exists
|
||||
execIfExists :: (Applicative f, Monad f, MonadIO f) => FilePath -> f () -> f ()
|
||||
@ -196,7 +195,7 @@ module System.Serverman.Utils ( App (..)
|
||||
appendAfter :: String -> String -> String -> String
|
||||
appendAfter content after line =
|
||||
let ls = lines content
|
||||
appended = concat $ map (\x -> if x == after then [x, line] else [x]) ls
|
||||
appended = concatMap (\x -> if x == after then [x, line] else [x]) ls
|
||||
|
||||
in unlines appended
|
||||
|
||||
@ -214,21 +213,21 @@ module System.Serverman.Utils ( App (..)
|
||||
| otherwise = input
|
||||
|
||||
execute :: String -> [String] -> String -> Bool -> App (Either String String)
|
||||
execute cmd args stdin logErrors = exec cmd args stdin Nothing logErrors
|
||||
execute cmd args stdin = exec cmd args stdin Nothing
|
||||
|
||||
-- execute a command in operating system
|
||||
-- if in remote mode, runs `execRemote`
|
||||
exec :: String -> [String] -> String -> Maybe FilePath -> Bool -> App (Either String String)
|
||||
exec cmd args stdin cwd logErrors = do
|
||||
verbose $ "exec: " ++ cmd ++ " " ++ show args
|
||||
(AppState { remoteMode }) <- get
|
||||
AppState { remoteMode } <- get
|
||||
|
||||
if isJust remoteMode then do
|
||||
let (addr, key) = fromJust remoteMode
|
||||
|
||||
execRemote addr (Just key) Nothing "" cmd args stdin cwd logErrors
|
||||
else do
|
||||
let command = escape $ cmd ++ " " ++ intercalate " " args
|
||||
let command = escape $ cmd ++ " " ++ unwords args
|
||||
cp = (proc (escape cmd) (map escape args)) { cwd = cwd }
|
||||
|
||||
verbose $ "executing command |" ++ command ++ "|"
|
||||
@ -242,7 +241,7 @@ module System.Serverman.Utils ( App (..)
|
||||
return $ Right stdout
|
||||
|
||||
Right (ExitFailure code, stdout, stderr) -> do
|
||||
when (not logErrors) $ verbose $ "command failed: " ++ show code ++ ", stderr: " ++ stderr
|
||||
unless logErrors $ verbose $ "command failed: " ++ show code ++ ", stderr: " ++ stderr
|
||||
when logErrors $ do
|
||||
err command
|
||||
err $ "exit code: " ++ show code
|
||||
@ -250,7 +249,7 @@ module System.Serverman.Utils ( App (..)
|
||||
err stderr
|
||||
return $ Left stdout
|
||||
Left e -> do
|
||||
when (not logErrors) $ verbose $ "couldn't execute command: " ++ show e
|
||||
unless logErrors $ verbose $ "couldn't execute command: " ++ show e
|
||||
when logErrors $ do
|
||||
err command
|
||||
err $ show e
|
||||
@ -284,12 +283,12 @@ module System.Serverman.Utils ( App (..)
|
||||
|
||||
cumulated = p ++ keyArgument ++ options
|
||||
command = userArgument ++ ["sh -c \"", cmd] ++ args ++ ["\""]
|
||||
complete = "-w" : "ssh" : (cumulated ++ [connection] ++ (intersperse " " command))
|
||||
complete = "-w" : "ssh" : (cumulated ++ [connection] ++ intersperse " " command)
|
||||
|
||||
verbose $ "backing up environment variables"
|
||||
verbose "backing up environment variables"
|
||||
backupEnv <- ST.liftIO getEnvironment
|
||||
|
||||
when (not . null $ password) $ do
|
||||
unless (null password) $ do
|
||||
verbose $ "writing passwordFile for SSH " ++ passwordFile ++ " and setting SSH_ASKPASS"
|
||||
ST.liftIO $ do
|
||||
writeFile passwordFile $ "echo " ++ password
|
||||
@ -297,7 +296,7 @@ module System.Serverman.Utils ( App (..)
|
||||
setEnv "SSH_ASKPASS" passwordFile True
|
||||
|
||||
state <- get
|
||||
let (AppState { remoteMode = backup }) = state
|
||||
let AppState { remoteMode = backup } = state
|
||||
put $ state { remoteMode = Nothing }
|
||||
|
||||
verbose $ "executing command |setsid " ++ show complete ++ "|"
|
||||
@ -305,7 +304,7 @@ module System.Serverman.Utils ( App (..)
|
||||
result <- exec "setsid" complete stdin cwd logErrors
|
||||
put $ state { remoteMode = backup }
|
||||
|
||||
verbose $ "reseting environment and deleting password file"
|
||||
verbose "reseting environment and deleting password file"
|
||||
ST.liftIO $ do
|
||||
setEnvironment backupEnv
|
||||
execIfExists passwordFile $ removeFile passwordFile
|
||||
@ -322,7 +321,7 @@ module System.Serverman.Utils ( App (..)
|
||||
foldl' rep "" str
|
||||
where
|
||||
rep acc n
|
||||
| takeEnd (l - 1) acc ++ [n] == replacable = (dropEnd (l - 1) acc) ++ alt
|
||||
| takeEnd (l - 1) acc ++ [n] == replacable = dropEnd (l - 1) acc ++ alt
|
||||
| otherwise = acc ++ [n]
|
||||
|
||||
l = length replacable
|
||||
@ -336,7 +335,7 @@ module System.Serverman.Utils ( App (..)
|
||||
|
||||
-- execute using sudo
|
||||
executeRoot :: String -> [String] -> String -> Bool -> App (Either String String)
|
||||
executeRoot cmd args stdin logErrors = execute "sudo" (cmd:args) stdin logErrors
|
||||
executeRoot cmd args = execute "sudo" (cmd:args)
|
||||
|
||||
-- read password from user input (don't show the input)
|
||||
getPassword :: IO String
|
||||
@ -353,4 +352,4 @@ module System.Serverman.Utils ( App (..)
|
||||
indent (keyvalue tabularized " ")
|
||||
where
|
||||
maxKey = maximum $ map (length . fst) entries
|
||||
tabularized = map (\(key, value) -> (key ++ (replicate (maxKey - length key + 1) ' '), value)) entries
|
||||
tabularized = map (\(key, value) -> (key ++ replicate (maxKey - length key + 1) ' ', value)) entries
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
@ -29,7 +28,7 @@ module System.Term ( initialize ) where
|
||||
|
||||
-- parse parameters
|
||||
let params = parseParams args
|
||||
isHelp = or $ map (`elem` args) ["help", "--help", "-h", "-?"]
|
||||
isHelp = any (`elem` args) ["help", "--help", "-h", "-?"]
|
||||
|
||||
-- Fetch repository first
|
||||
S.runApp $ do
|
||||
@ -41,34 +40,34 @@ module System.Term ( initialize ) where
|
||||
verbose $ show params
|
||||
|
||||
-- fetch repository if running for the first time, set state
|
||||
S.run (S.fetchRepository)
|
||||
S.run S.fetchRepository
|
||||
|
||||
-- detect local operating system
|
||||
S.run (S.detectOS)
|
||||
S.run S.detectOS
|
||||
|
||||
state@(S.AppState { S.repository }) <- get
|
||||
state@S.AppState { S.repository } <- get
|
||||
put $ state { arguments = rest params, helpArg = isHelp }
|
||||
|
||||
case params of
|
||||
-- list services in repository
|
||||
(Params { listServices = True }) -> do
|
||||
Params { listServices = True } ->
|
||||
mapM_ (write . show) repository
|
||||
|
||||
-- install a service
|
||||
p@(Params { install = Just service }) -> do
|
||||
p@Params { install = Just service } -> do
|
||||
verbose $ "preparing to install " ++ service
|
||||
ms <- findService service
|
||||
case ms of
|
||||
Just s -> handleRemote p $ S.install s
|
||||
Nothing -> die $ "service not found: " ++ service
|
||||
|
||||
p@(Params { update = True }) -> S.run (S.updateRepository)
|
||||
p@Params { update = True } -> S.run S.updateRepository
|
||||
|
||||
p@(Params { manage = Just (act, service) }) -> do
|
||||
p@Params { manage = Just (act, service) } -> do
|
||||
verbose $ "preparing to " ++ show act ++ " " ++ service
|
||||
ms <- findService service
|
||||
case ms of
|
||||
Just s -> do
|
||||
Just s ->
|
||||
case act of
|
||||
Start ->
|
||||
handleRemote p $ S.start s
|
||||
@ -79,7 +78,7 @@ module System.Term ( initialize ) where
|
||||
die $ "could not find any service matching " ++ service
|
||||
|
||||
-- install and call a service
|
||||
p@(Params { rest = (x:xs), remote }) -> do
|
||||
p@Params { rest = (x:xs), remote } ->
|
||||
case x of
|
||||
(service, Nothing) -> do
|
||||
verbose $ "preparing to call " ++ service
|
||||
@ -87,12 +86,12 @@ module System.Term ( initialize ) where
|
||||
ms <- findService service
|
||||
case ms of
|
||||
Just s -> do
|
||||
when (not isHelp) $ do
|
||||
handleRemote p $ S.install s
|
||||
unless isHelp $
|
||||
handleRemote p (S.install s)
|
||||
|
||||
S.run $ S.call s remote
|
||||
|
||||
Nothing -> do
|
||||
Nothing ->
|
||||
if isHelp then
|
||||
servermanHelp
|
||||
else
|
||||
@ -101,7 +100,7 @@ module System.Term ( initialize ) where
|
||||
|
||||
-- after the program is done, terminate remaining processes
|
||||
-- and unmount/remove leftover temporary directories
|
||||
state@(S.AppState { S.processes, S.temps }) <- get
|
||||
state@S.AppState { S.processes, S.temps } <- get
|
||||
put $ state { remoteMode = Nothing }
|
||||
|
||||
mapM_ (liftIO . terminateProcess) processes
|
||||
@ -115,10 +114,10 @@ module System.Term ( initialize ) where
|
||||
liftIO $ removeDirectoryRecursive path
|
||||
-- if remote mode is set, read the file and run the action
|
||||
-- on servers, otherwise run action locally
|
||||
handleRemote (Params { remote = Just file }) action = do
|
||||
list <- liftIO $ map read . lines <$> readFile file
|
||||
S.run (S.remote list action)
|
||||
handleRemote (Params { remote = Nothing }) action = S.run action
|
||||
handleRemote Params { remote = Just file } action = do
|
||||
list <- liftIO $ filter (not . null) . lines <$> readFile file
|
||||
S.run (S.remote (map read list) action)
|
||||
handleRemote Params { remote = Nothing } action = S.run action
|
||||
|
||||
servermanHelp = do
|
||||
write "serverman [--options] [command/service] [--service-options]"
|
||||
@ -145,7 +144,7 @@ module System.Term ( initialize ) where
|
||||
}
|
||||
|
||||
instance Show Params where
|
||||
show (Params { listServices, install, manage, update, remote, rest, verboseM }) =
|
||||
show Params { listServices, install, manage, update, remote, rest, verboseM } =
|
||||
keyvalue [ ("list-services", show listServices)
|
||||
, ("install", show install)
|
||||
, ("manage", show manage)
|
||||
@ -177,9 +176,9 @@ module System.Term ( initialize ) where
|
||||
toPairs [] = []
|
||||
toPairs [x] = [(getWord x, Nothing)]
|
||||
toPairs (x:y:xs)
|
||||
| flagName x && value y = [(getWord x, Just y)] ++ toPairs xs
|
||||
| flagName y && value x = [(getWord x, Nothing)] ++ toPairs (y:xs)
|
||||
| flagName x && flagName y = [(getWord x, Nothing)] ++ toPairs (y:xs)
|
||||
| flagName x && value y = (getWord x, Just y) : toPairs xs
|
||||
| flagName y && value x = (getWord x, Nothing) : toPairs (y:xs)
|
||||
| flagName x && flagName y = (getWord x, Nothing) : toPairs (y:xs)
|
||||
| otherwise = toPairs xs
|
||||
|
||||
flagName = isPrefixOf "-"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user