summaryrefslogtreecommitdiff
path: root/src/main
diff options
context:
space:
mode:
Diffstat (limited to 'src/main')
-rw-r--r--src/main/frege/buildclient/config/BuildConfig.fr88
-rw-r--r--src/main/frege/buildclient/config/BuildParser.fr117
-rw-r--r--src/main/frege/buildclient/config/BuildUniverse.fr8
-rw-r--r--src/main/frege/examples/HelloFrege.fr10
-rw-r--r--src/main/resources/testconfig.bcc17
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"
+}
+
generated by cgit (git 2.46.0) at 2024-11-25 08:56:39 +0000