Initial commit

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"
+}
+