diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/main/frege/buildclient/config/BuildConfig.fr | 88 | ||||
| -rw-r--r-- | src/main/frege/buildclient/config/BuildParser.fr | 117 | ||||
| -rw-r--r-- | src/main/frege/buildclient/config/BuildUniverse.fr | 8 | ||||
| -rw-r--r-- | src/main/frege/examples/HelloFrege.fr | 10 | ||||
| -rw-r--r-- | src/main/resources/testconfig.bcc | 17 |
5 files changed, 240 insertions, 0 deletions
diff --git a/src/main/frege/buildclient/config/BuildConfig.fr b/src/main/frege/buildclient/config/BuildConfig.fr new file mode 100644 index 0000000..89be3a7 --- /dev/null +++ b/src/main/frege/buildclient/config/BuildConfig.fr @@ -0,0 +1,88 @@ +module buildclient.config.BuildConfig where +import buildclient.config.BuildParser + + + +(<?>) :: Maybe b -> a -> Either a b +(<?>) = flip maybeToEither + +(<#>) :: (c -> Maybe b) -> a -> (c -> Either a b) +(<#>) f a b = f b <?> a + +maybeToEither :: a -> Maybe b -> Either a b +maybeToEither _ (Just v) = Right v +maybeToEither e _ = Left e + +extractSingleArg :: ASTDirective -> Maybe ASTValue +extractSingleArg (ASTDirective _ [value] []) = Just value +extractSingleArg _ = Nothing + + +getArgDirective :: String -> [ASTDirective] -> Maybe ASTValue +getArgDirective name directives = findDirective name directives >>= extractSingleArg + +getTypedArg :: String -> String -> [ASTDirective] -> (ASTValue -> Maybe a) -> Either String a +getTypedArg name label directives mapper = + (findDirective name directives <?> ("Please add the missing " ++ label)) + >>= (extractSingleArg <#> ("Please add an argument to the " ++ label)) + >>= (mapper <#> ("Invalid argument type for " ++ label)) + +getArg :: ASTDirective -> Int -> Maybe ASTValue +getArg (ASTDirective _ args _) = getArg' args + where getArg' (a : _) 0 = Just a + getArg' (a : as) i = getArg' as (i - 1) + getArg' [] _ = Nothing + +toString :: ASTValue -> Maybe String +toString (ASTValue.ASTString str) = Just str +toString (ASTValue.ASTWord str) = Just str +toString _ = Nothing + +expectString :: ASTValue -> Maybe String +expectString (ASTValue.ASTString str) = Just str +expectString _ = Nothing + + + + +data BuildSource = GitSource {upstream :: String, branch :: Maybe String} +derive Show BuildSource + +findSource :: ASTDirective -> Either String BuildSource +findSource (ASTDirective _ [ASTWord "git"] block) = do + upstream <- getTypedArg "upstream" "git upstream directive" block expectString + return $ GitSource upstream (getArgDirective "branch" block >>= expectString) +findSource (ASTDirective _ [ASTWord name] _) = Left ("Unknown source type " ++ name) +findSource _ = Left "Please provide a source type" + + +data BuildSystem = GradleBuild { task::String, project :: Maybe String } +derive Show BuildSystem + + +findBuildSystem :: ASTDirective -> Either String BuildSystem +findBuildSystem (ASTDirective _ [ASTWord "gradle"] block) = do + task <- getTypedArg "task" "gradle task" block expectString + return $ GradleBuild task $ (getArgDirective "project" block >>= expectString) + +parseBuildConfig :: [ASTDirective] -> Either String BuildConfig +parseBuildConfig directives = do + modid <- getTypedArg "modid" "modid" directives expectString + label <- getTypedArg "label" "label" directives expectString + description <- getTypedArg "description" "description" directives expectString + author <- getTypedArg "author" "author" directives expectString + source <- findDirective "source" directives <?> "Please provide a source block" >>= findSource + build <- findDirective "build" directives <?> "Please provide a build block" >>= findBuildSystem + return $ BuildConfig modid label description author (getArgDirective "webpresence" directives >>= expectString) source build + +data BuildConfig = BuildConfig + { modid :: String + , label :: String + , description :: String + , author :: String + , webpresence :: Maybe String + , source :: BuildSource + , build :: BuildSystem + } + +derive Show BuildConfig
\ No newline at end of file diff --git a/src/main/frege/buildclient/config/BuildParser.fr b/src/main/frege/buildclient/config/BuildParser.fr new file mode 100644 index 0000000..f2cc763 --- /dev/null +++ b/src/main/frege/buildclient/config/BuildParser.fr @@ -0,0 +1,117 @@ +module buildclient.config.BuildParser where + +import Data.MicroParsec as MP + +-- <section> +-- </section> +data Token = + BareWord {bval::String} + | Number {nval::String} + | BraceOpen + | BraceClose + | NewLine + | QuotedString {sval::String} + | ERROR {position::Int, message:: String} +derive Eq Token +derive Show Token + +protected type Parser = MP.Parser [] Token + +protected isIdentifierStartChar :: Char -> Bool +protected isIdentifierStartChar char = ('A' <= char && char <= 'Z') || ('a' <= char && char <= 'z') || char == '_' + +protected isDigit :: Char -> Bool +protected isDigit char = ('0' <= char && char <= '9') + +protected isIdentifierChar :: Char -> Bool +protected isIdentifierChar char = isIdentifierStartChar char || isDigit char + +lexer :: String -> [Token] +lexer s = lex s 0 + +private lex :: String -> Int -> [Token] +private lex !cs !start + | endOfSeq = [] + | ch == '\n' = Token.NewLine : lex cs (start + 1) + | ch.isWhitespace = lex cs (start + 1) + | ch == '"' = string 1 [] + | ch == '{' = Token.BraceOpen : lex cs (start + 1) + | ch == '}' = Token.BraceClose : lex cs (start + 1) + | isDigit ch = takeWhile isDigit Token.Number 0 [] + | isIdentifierStartChar ch = takeWhile isIdentifierChar Token.BareWord 0 [] + | otherwise -> [Token.ERROR{position=start, message="Unexpected character"}] + where + endOfSeq = start >= cs.length + ch = at 0 + at i = if start + i >= cs.length then '\0' else cs.charAt (start + i) + takeWhile charTest mapper off !acc + | charTest $ at off = takeWhile charTest mapper (off + 1) (at off : acc) + | otherwise = (mapper $ packed $ reverse acc) : lex cs (start + off) + string off !acc + | start + off >= cs.length = [Token.ERROR{position=start + off, message="Unterminated string literal"}] + | ch == '"' -> (Token.QuotedString $ packed (reverse acc)) : lex cs (start + off + 1) + | ch >= ' ' || ch == '\n' || ch == '\t' -> string (off + 1) (ch : acc) + | otherwise -> [Token.ERROR{position=start+off, message="Unknown string character"}] + where + ch = at off + + + +runParser :: Parser a -> [Token] -> (String | a) +runParser p ts = case MP.runid p ts of + (Left msg, ts) → Left (MP.reporterror ts msg) + (right, _) → right + + + +protected parseNewLine :: Parser () +protected parseNewLine = const () <$> expect Token.NewLine <?> "newline expected" + +protected parseLBrace :: Parser () +protected parseLBrace = const () <$> expect Token.BraceOpen <?> "opening braces expected" + +protected parseRBrace :: Parser () +protected parseRBrace = const () <$> expect Token.BraceClose <?> "closing braces expected" + +protected parseEndOfStatement :: Parser () +protected parseEndOfStatement = (parseNewLine <|> parseRBrace <|> eos) <?> "expected end of statement" + +protected parseBareWord :: Parser String +protected parseBareWord = (_.bval) <$> satisfy _.{bval?} <?> "bareword expected" + +protected parseQuotedString :: Parser String +protected parseQuotedString = (_.sval) <$> satisfy _.{sval?} <?> "string expected" + +protected parseNumber :: Parser String +protected parseNumber = (_.nval) <$> satisfy _.{nval?} <?> "number expected" + +data ASTValue = ASTString String | ASTWord String | ASTNumber Int +data ASTDirective = ASTDirective {name::String, arguments:: [ASTValue], block:: [ASTDirective]} +derive Show ASTValue +derive Show ASTDirective + +protected parseValue :: Parser ASTValue +protected parseValue = ASTString <$> parseQuotedString <|> ASTWord <$> parseBareWord <|> (ASTNumber . read) <$> parseNumber + +protected parseShortDirective :: Parser ASTDirective +protected parseShortDirective = do + skip parseNewLine + name <- parseBareWord <?> "directive name expected" + args <- many parseValue + cond (parseEndOfStatement) + (return $ ASTDirective name args []) + do + parseLBrace + subdirectives <- many parseShortDirective + skip parseNewLine + parseRBrace + return $ ASTDirective name args subdirectives + +parseFile :: Parser [ASTDirective] +parseFile = (many parseShortDirective) <* (skip parseNewLine) <* eos + +findDirective :: String -> [ASTDirective] -> Maybe ASTDirective +findDirective name (directive:ds) + | directive.name == name = Just directive + | otherwise = findDirective name ds +findDirective _ [] = Nothing diff --git a/src/main/frege/buildclient/config/BuildUniverse.fr b/src/main/frege/buildclient/config/BuildUniverse.fr new file mode 100644 index 0000000..6e7c8f4 --- /dev/null +++ b/src/main/frege/buildclient/config/BuildUniverse.fr @@ -0,0 +1,8 @@ +module buildclient.config.BuildUniverse where +import buildclient.config.BuildConfig + +data BuildUniverse = BuildUniverse [BuildConfig] + + + + diff --git a/src/main/frege/examples/HelloFrege.fr b/src/main/frege/examples/HelloFrege.fr new file mode 100644 index 0000000..ff80635 --- /dev/null +++ b/src/main/frege/examples/HelloFrege.fr @@ -0,0 +1,10 @@ +module examples.HelloFrege where +import Test.QuickCheck +import buildclient.config.BuildParser (parseShortDirective, lexer, runParser, parseFile, findDirective) +import buildclient.config.BuildConfig (findSource, findBuildSystem, parseBuildConfig) + +main = do + text <- readFile "src/main/resources/testconfig.bcc" + let lexed = lexer text + let (Right d) = runParser parseFile lexed + println $ show $ parseBuildConfig d diff --git a/src/main/resources/testconfig.bcc b/src/main/resources/testconfig.bcc new file mode 100644 index 0000000..d565639 --- /dev/null +++ b/src/main/resources/testconfig.bcc @@ -0,0 +1,17 @@ +modid "dankersskyblockmod" +label "Dankers Skyblock Mod" +description "Dankers Mod + +Multi Line test" +author "Danker" +webpresence "https://github.com/bowser0000/SkyblockMod" +source git { + upstream "https://github.com/bowser0000/SkyblockMod.git" + branch "development" +} + +build gradle { + task "jar" + project "forge-1.8.9" +} + |