diff options
| -rw-r--r-- | src/main/frege/buildclient/config/BuildConfig.fr | 18 | ||||
| -rw-r--r-- | src/main/frege/buildclient/config/BuildParser.fr | 5 | ||||
| -rw-r--r-- | src/main/frege/examples/HelloFrege.fr | 7 | ||||
| -rw-r--r-- | src/main/resources/testconfig.bcc | 1 |
4 files changed, 20 insertions, 11 deletions
diff --git a/src/main/frege/buildclient/config/BuildConfig.fr b/src/main/frege/buildclient/config/BuildConfig.fr index 89be3a7..603f1a8 100644 --- a/src/main/frege/buildclient/config/BuildConfig.fr +++ b/src/main/frege/buildclient/config/BuildConfig.fr @@ -42,7 +42,9 @@ expectString :: ASTValue -> Maybe String expectString (ASTValue.ASTString str) = Just str expectString _ = Nothing - +expectNumber :: ASTValue -> Maybe Int +expectNumber (ASTValue.ASTNumber num) = Just num +expectNumber _ = Nothing data BuildSource = GitSource {upstream :: String, branch :: Maybe String} @@ -52,8 +54,8 @@ 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" +findSource (ASTDirective _ [ASTWord name] _) = fail ("Unknown source type " ++ name) +findSource _ = fail "Please provide a source type" data BuildSystem = GradleBuild { task::String, project :: Maybe String } @@ -64,9 +66,12 @@ 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) +findBuildSystem _ = fail "Please provide a build system" parseBuildConfig :: [ASTDirective] -> Either String BuildConfig parseBuildConfig directives = do + version <- getTypedArg "schema" "schema" directives expectNumber + when (version != 1) $ fail "Invalid schema version. Needs to be 1" modid <- getTypedArg "modid" "modid" directives expectString label <- getTypedArg "label" "label" directives expectString description <- getTypedArg "description" "description" directives expectString @@ -75,6 +80,13 @@ parseBuildConfig directives = do build <- findDirective "build" directives <?> "Please provide a build block" >>= findBuildSystem return $ BuildConfig modid label description author (getArgDirective "webpresence" directives >>= expectString) source build +parseBuildConfigStr :: String -> Either String BuildConfig +parseBuildConfigStr str = reportErr tokens >> (runParser parseFile tokens) >>= parseBuildConfig + where reportErr (Token.ERROR position msg:_) = fail ("Error at position " ++ (show position) ++ ": " ++ msg) + reportErr (_:as) = reportErr as + reportErr _ = return () + tokens = lexer str + data BuildConfig = BuildConfig { modid :: String , label :: String diff --git a/src/main/frege/buildclient/config/BuildParser.fr b/src/main/frege/buildclient/config/BuildParser.fr index 23e15ff..367b177 100644 --- a/src/main/frege/buildclient/config/BuildParser.fr +++ b/src/main/frege/buildclient/config/BuildParser.fr @@ -29,7 +29,7 @@ lexer s = lex s 0 private lex :: String -> Int -> [Token] private lex !cs !start - | endOfSeq = [] + | start >= cs.length = [] | ch == '\\' && at 1 == '\n' = lex cs (start + 2) | ch == '\n' = Token.NewLine : lex cs (start + 1) | ch.isWhitespace = lex cs (start + 1) @@ -38,9 +38,8 @@ private lex !cs !start | 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"}] + | otherwise -> [Token.ERROR{position=start, message="Unexpected character " ++ (show ch)}] 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 diff --git a/src/main/frege/examples/HelloFrege.fr b/src/main/frege/examples/HelloFrege.fr index ff80635..6fe88f7 100644 --- a/src/main/frege/examples/HelloFrege.fr +++ b/src/main/frege/examples/HelloFrege.fr @@ -1,10 +1,7 @@ module examples.HelloFrege where import Test.QuickCheck -import buildclient.config.BuildParser (parseShortDirective, lexer, runParser, parseFile, findDirective) -import buildclient.config.BuildConfig (findSource, findBuildSystem, parseBuildConfig) +import buildclient.config.BuildConfig (parseBuildConfigStr) main = do text <- readFile "src/main/resources/testconfig.bcc" - let lexed = lexer text - let (Right d) = runParser parseFile lexed - println $ show $ parseBuildConfig d + println $ show $ parseBuildConfigStr text diff --git a/src/main/resources/testconfig.bcc b/src/main/resources/testconfig.bcc index e218c7e..1dae2b2 100644 --- a/src/main/resources/testconfig.bcc +++ b/src/main/resources/testconfig.bcc @@ -1,3 +1,4 @@ +schema 1 modid "dankersskyblockmod" label "Dankers Skyblock Mod" description \ |