ServerSchemaJsonParser.hs

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