summaryrefslogtreecommitdiff
path: root/src/main/frege
diff options
context:
space:
mode:
Diffstat (limited to 'src/main/frege')
-rw-r--r--src/main/frege/buildclient/config/BuildConfig.fr18
-rw-r--r--src/main/frege/buildclient/config/BuildParser.fr5
-rw-r--r--src/main/frege/examples/HelloFrege.fr7
3 files changed, 19 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