Commits

nakamura committed 4929979

write Daemon parser

Comments (0)

Files changed (1)

+{-# LANGUAGE PatternGuards #-}
+module Parser where
+
+import Control.Applicative ((<*), (*>), (<$>), (<*>))
+import Data.List (intercalate)
+import Text.ParserCombinators.Parsec
+
+import Common
+
+
+data DaemonFields = DF { dfName      :: Maybe String
+                       , dfCommand   :: Maybe String
+                       , dfArgs      :: Maybe [String]
+                       , dfCwd       :: Maybe String
+                       , dfEnv       :: Maybe [(String, String)]
+                       , dfAutoStart :: Maybe Bool
+                       }
+
+fieldToDaemon (DF (Just name) (Just cmd) (Just args) (Just cwd) (Just env) (Just auto)) = Daemon name cmd args cwd env auto
+
+emptyFields = DF Nothing Nothing Nothing Nothing Nothing Nothing
+
+completed :: DaemonFields -> Bool
+completed df = undefinedNames df == []
+
+undefinedNames :: DaemonFields -> [String]
+undefinedNames df = undefinedNames' df []
+
+undefinedNames' :: DaemonFields -> [String] -> [String]
+undefinedNames' df fs
+    | Nothing <- dfAutoStart df = undefinedNames' df { dfAutoStart = Just undefined } $ "dAutoStart":fs
+    | Nothing <- dfEnv df       = undefinedNames' df { dfEnv = Just undefined } $ "dEnv":fs
+    | Nothing <- dfCwd df       = undefinedNames' df { dfCwd = Just undefined } $ "dCwd":fs
+    | Nothing <- dfArgs df      = undefinedNames' df { dfArgs = Just undefined } $ "dArgs":fs
+    | Nothing <- dfCommand df   = undefinedNames' df { dfCommand = Just undefined } $ "dCommand":fs
+    | Nothing <- dfName df      = undefinedNames' df { dfName = Just undefined } $ "dName":fs
+    | otherwise = fs
+
+parseDaemonFile :: FilePath -> IO (Either ParseError Daemon)
+parseDaemonFile fp = parseFromFile parseDaemon fp
+
+parseDaemon :: Parser Daemon
+parseDaemon = do
+    spaces
+    string "Daemon"
+    spaces
+    df <- braces $ fields emptyFields
+    if completed df
+      then return $ fieldToDaemon df
+      else fail $ "undefined fields: " ++ intercalate ", " (undefinedNames df)
+
+fields :: DaemonFields -> Parser DaemonFields
+fields df = do
+    df' <- field df
+    try ((lookAhead $ symbol "}") >> return df')
+        <|> (comma >> fields df')
+
+field :: DaemonFields -> Parser DaemonFields
+field df = fieldName df <|> fieldCommand df <|> fieldArgs df <|> fieldCwd df <|> fieldAutoStart df <|> fieldEnv df
+
+fieldName, fieldCommand, fieldArgs, fieldCwd, fieldEnv, fieldAutoStart :: DaemonFields -> Parser DaemonFields
+fieldName = mkFieldParser "dName" dfName quotedString (\v f -> f { dfName = Just v })
+fieldCommand = mkFieldParser "dCommand" dfCommand quotedString (\v f -> f { dfCommand = Just v })
+fieldArgs = mkFieldParser "dArgs" dfArgs listOfString (\v f -> f { dfArgs = Just v })
+fieldCwd = mkFieldParser "dCwd" dfCwd quotedString (\v f -> f { dfCwd = Just v })
+fieldEnv = mkFieldParser "dEnv" dfEnv aListOfString (\v f -> f { dfEnv = Just v })
+fieldAutoStart = mkFieldParser "dAutoStart" dfAutoStart bool (\v f -> f { dfAutoStart = Just v })
+
+mkFieldParser :: String         -- ^ Field name
+              -> (f -> Maybe a) -- ^ field duplication check function
+              -> Parser b       -- ^ parser for field body
+              -> (b -> f -> f)  -- ^ field update function
+              -> (f -> Parser f)
+mkFieldParser fn fc p fu df = do
+    try $ string fn
+    spaces
+    equal
+    fv <- lexeme p
+    case fc df of
+        Just _  -> fail $ "duplicated field: " ++ fn
+        Nothing -> return (fu fv df)
+
+quotedString :: Parser String
+quotedString = (lexeme $ char '"' *> (concat <$> many quotedChar) <* char '"')
+    <?> "quoted-string"
+
+quotedChar :: Parser String
+quotedChar = do
+    c <- noneOf ['"']
+    case c of
+        '\\' -> do
+            c' <- anyChar
+            return [c, c']
+        _    -> return [c]
+
+list :: Parser a -> Parser [a]
+list p = bracket $ sepBy p comma
+
+listOfString :: Parser [String]
+listOfString = lexeme $ list quotedString
+
+aListOfString :: Parser [(String, String)]
+aListOfString = lexeme $ list $ pair quotedString quotedString
+
+pair :: Parser a -> Parser b -> Parser (a, b)
+pair p p' = lexeme $ parens $ (,) <$> p <*> (comma *> p')
+
+bool :: Parser Bool
+bool = string "True" *> return True
+   <|> string "False" *> return False
+
+lexeme p = p <* spaces
+
+symbol = lexeme . string
+
+braces = between (symbol "{") (symbol "}")
+bracket = between (symbol "[") (symbol "]")
+parens  = between (symbol "(") (symbol ")")
+
+comma = symbol ","
+equal = symbol "="
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.