module Components.Parsers.ServerSchemaJsonParser (fetchArguments) where import qualified Control.Exception as E import Text.JSON import Model.ServerExceptions fetchArguments :: FilePath -> IO ([(String,[String])],[(String,[String])],[(String,[String])],[(String,[String])],[(String,String,[String])]) fetchArguments fp = do schema <- Prelude.readFile fp let parsed = schema return $ parseSchema parsed parseSchema :: String -> ([(String,[String])],[(String,[String])],[(String,[String])],[(String,[String])],[(String,String,[String])]) parseSchema str = parseHelper [] [] [] [] [] $ checkJSValueListValue (decode str :: Result [JSValue]) checkJSValueListValue :: Result [JSValue] -> [JSValue] checkJSValueListValue (Error str) = E.throw ImportSchemaException checkJSValueListValue (Ok a) = a parseHelper :: [(String,[String])] -> [(String,[String])] -> [(String,[String])] -> [(String,[String])] -> [(String,String,[String])] -> [JSValue] -> ([(String,[String])],[(String,[String])],[(String,[String])],[(String,[String])],[(String,String,[String])]) parseHelper svrobjs sss sos sdbn sor [] = (svrobjs,sss,sos,sdbn,sor) parseHelper svrobjs sss sos sdbn sor ((JSObject obj):t) = parseHelper ((name,pseudonyms):svrobjs) ((name,scalars):sss) ((name,nestedobjects):sos) ((name,tables):sdbn) (sor++(processRelationships relationships)) t where name = getServerName (valFromObj "servername" obj :: Result String) pseudonyms = getStringList (valFromObj "pseudonyms" obj :: Result [String]) 0 scalars = getStringList (valFromObj "scalarfields" obj :: Result [String]) 1 nestedobjects = getStringList (valFromObj "objectfields" obj :: Result [String]) 2 tables = getStringList (valFromObj "databasetables" obj :: Result [String]) 3 relationships = getListStringList (valFromObj "databaserelationships" obj :: Result [[String]]) getServerName :: Result String -> String getServerName (Error str) = E.throw ImportSchemaServerNameException getServerName (Ok name) = name getStringList :: Result [String] -> Int -> [String] getStringList (Ok rlt) _ = rlt getStringList _ t | t==0 = E.throw ImportSchemaPseudonymsException | t==1 = E.throw ImportSchemaScalarFieldsException | t==2 = E.throw ImportSchemaObjectFieldsException | t==3 = E.throw ImportSchemaDatabaseTablesException | otherwise = E.throw ImportSchemaException getListStringList :: Result [[String]] -> [[String]] getListStringList (Error str) = E.throw ImportSchemaDatabaseRelationshipsException getListStringList (Ok rlt) = rlt processRelationships :: [[String]] -> [(String,String,[String])] processRelationships lst = foldr (\x y -> (getFirst x,getThird x, x):y) [] lst getFirst :: [String] -> String getFirst (h:t) = h getFirst _ = E.throw ImportSchemaException getThird :: [String] -> String getThird (h1:h2:h3:t) = h3 getThird _ = E.throw ImportSchemaException