Initial commit

1 files changed, 88 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