module Components.Parsers.ServerSchemaJsonParser (fetchArguments) where

import Control.Exception (throw)
import Text.JSON (
    JSValue(JSObject),
    JSObject,
    Result(Ok),
    valFromObj,
    decode
  )
import Model.ServerExceptions (
    SchemaException(
      ReadSchemaFileException,
      SchemaDuplicateServerObjectException,
      SchemaDuplicateInterfaceException,
      ReadJsonObjectsException,
      ReadServerNameStringException,
      ReadScalarFieldException,
      ReadDatabaseTableException,
      ReadJsonStringException,
      ReadPseudonymsException,
      ReadInterfaceInstancesException,
      ReadDatabaseIdsException,
      ReadJsonStringListException,
      ReadDatabaseRelationshipsException,
      ScalarFieldDataTypeException,
      ReadDatabaseRelationshipsCardinalityException,
      PrimaryObjectNotFoundException,
      SchemaDuplicateException,
      InterfaceScalarTypesException
    )
  )
import Components.Util (snd3,fst3,fst4)


fetchArguments :: FilePath -> IO ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])
fetchArguments :: FilePath
-> IO
     ([(FilePath, [FilePath])],
      [(FilePath,
        [(FilePath, FilePath,
          [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
      [(FilePath, [(FilePath, [FilePath])])],
      [(FilePath, [FilePath], FilePath)],
      [(FilePath, FilePath, [FilePath])],
      [(FilePath, [FilePath], [FilePath])])
fetchArguments fp :: FilePath
fp = do 
    FilePath
schema <- FilePath -> IO FilePath
Prelude.readFile FilePath
fp
    ([(FilePath, [FilePath])],
 [(FilePath,
   [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
 [(FilePath, [(FilePath, [FilePath])])],
 [(FilePath, [FilePath], FilePath)],
 [(FilePath, FilePath, [FilePath])],
 [(FilePath, [FilePath], [FilePath])])
-> IO
     ([(FilePath, [FilePath])],
      [(FilePath,
        [(FilePath, FilePath,
          [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
      [(FilePath, [(FilePath, [FilePath])])],
      [(FilePath, [FilePath], FilePath)],
      [(FilePath, FilePath, [FilePath])],
      [(FilePath, [FilePath], [FilePath])])
forall (m :: * -> *) a. Monad m => a -> m a
return (([(FilePath, [FilePath])],
  [(FilePath,
    [(FilePath, FilePath,
      [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
  [(FilePath, [(FilePath, [FilePath])])],
  [(FilePath, [FilePath], FilePath)],
  [(FilePath, FilePath, [FilePath])],
  [(FilePath, [FilePath], [FilePath])])
 -> IO
      ([(FilePath, [FilePath])],
       [(FilePath,
         [(FilePath, FilePath,
           [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
       [(FilePath, [(FilePath, [FilePath])])],
       [(FilePath, [FilePath], FilePath)],
       [(FilePath, FilePath, [FilePath])],
       [(FilePath, [FilePath], [FilePath])]))
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
-> IO
     ([(FilePath, [FilePath])],
      [(FilePath,
        [(FilePath, FilePath,
          [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
      [(FilePath, [(FilePath, [FilePath])])],
      [(FilePath, [FilePath], FilePath)],
      [(FilePath, FilePath, [FilePath])],
      [(FilePath, [FilePath], [FilePath])])
forall a b. (a -> b) -> a -> b
$ FilePath
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
parseSchema FilePath
schema
parseSchema :: String -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])
parseSchema :: FilePath
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
parseSchema str :: FilePath
str = JSObject JSValue
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
parseHelper (JSObject JSValue
 -> ([(FilePath, [FilePath])],
     [(FilePath,
       [(FilePath, FilePath,
         [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
     [(FilePath, [(FilePath, [FilePath])])],
     [(FilePath, [FilePath], FilePath)],
     [(FilePath, FilePath, [FilePath])],
     [(FilePath, [FilePath], [FilePath])]))
-> JSObject JSValue
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
forall a b. (a -> b) -> a -> b
$ Result (JSObject JSValue) -> JSObject JSValue
checkJSValueListValue (FilePath -> Result (JSObject JSValue)
forall a. JSON a => FilePath -> Result a
decode FilePath
str :: Result (JSObject JSValue))
checkJSValueListValue :: Result (JSObject JSValue) -> (JSObject JSValue)
checkJSValueListValue :: Result (JSObject JSValue) -> JSObject JSValue
checkJSValueListValue (Ok a :: JSObject JSValue
a) = JSObject JSValue
a
checkJSValueListValue _ = SchemaException -> JSObject JSValue
forall a e. Exception e => e -> a
throw SchemaException
ReadSchemaFileException
parseHelper :: JSObject JSValue -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])
parseHelper :: JSObject JSValue
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
parseHelper json :: JSObject JSValue
json 
    | ([(FilePath, [FilePath], [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidParentScalars [(FilePath, [FilePath], [FilePath])]
soa [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss)Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
False = SchemaException
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
forall a e. Exception e => e -> a
throw SchemaException
InterfaceScalarTypesException
    | ([(FilePath, [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, FilePath, [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
-> Bool
isWithoutDups [(FilePath, [FilePath])]
svrobjs [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [(FilePath, [FilePath])])]
sos [(FilePath, FilePath, [FilePath])]
sor [(FilePath, [FilePath], [FilePath])]
soa)Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
False = SchemaException
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])],
    [(FilePath, [FilePath], [FilePath])])
forall a e. Exception e => e -> a
throw SchemaException
SchemaDuplicateException
    | Bool
otherwise = ([(FilePath, [FilePath])]
svrobjs,[(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,[(FilePath, [(FilePath, [FilePath])])]
sos,[(FilePath, [FilePath], FilePath)]
sdbn,[(FilePath, FilePath, [FilePath])]
sor,[(FilePath, [FilePath], [FilePath])]
soa)
  where
    (svrobjs :: [(FilePath, [FilePath])]
svrobjs,sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,sos :: [(FilePath, [(FilePath, [FilePath])])]
sos,sdbn :: [(FilePath, [FilePath], FilePath)]
sdbn,sor :: [(FilePath, FilePath, [FilePath])]
sor) = [(FilePath, [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, FilePath, [FilePath])]
-> [JSObject JSValue]
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])])
parsePrimitivesIterator [] [] [] [] [] ([JSObject JSValue]
 -> ([(FilePath, [FilePath])],
     [(FilePath,
       [(FilePath, FilePath,
         [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
     [(FilePath, [(FilePath, [FilePath])])],
     [(FilePath, [FilePath], FilePath)],
     [(FilePath, FilePath, [FilePath])]))
-> [JSObject JSValue]
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])])
forall a b. (a -> b) -> a -> b
$ Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "PrimaryObjects" JSObject JSValue
json :: Result [JSObject JSValue])
    soa :: [(FilePath, [FilePath], [FilePath])]
soa = [(FilePath, [FilePath], [FilePath])]
-> [JSObject JSValue] -> [(FilePath, [FilePath], [FilePath])]
parseParentsIterator [] ([JSObject JSValue] -> [(FilePath, [FilePath], [FilePath])])
-> [JSObject JSValue] -> [(FilePath, [FilePath], [FilePath])]
forall a b. (a -> b) -> a -> b
$ Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Interfaces" JSObject JSValue
json :: Result [JSObject JSValue])
parsePrimitivesIterator :: [(String,[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[(String,[String])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [JSObject JSValue] -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])])
parsePrimitivesIterator :: [(FilePath, [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, FilePath, [FilePath])]
-> [JSObject JSValue]
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])])
parsePrimitivesIterator svrobjs :: [(FilePath, [FilePath])]
svrobjs sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss sos :: [(FilePath, [(FilePath, [FilePath])])]
sos sdbn :: [(FilePath, [FilePath], FilePath)]
sdbn sor :: [(FilePath, FilePath, [FilePath])]
sor [] = ([(FilePath, [FilePath])]
svrobjs,[(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,[(FilePath, [(FilePath, [FilePath])])]
sos,[(FilePath, [FilePath], FilePath)]
sdbn,[(FilePath, FilePath, [FilePath])]
sor)
parsePrimitivesIterator svrobjs :: [(FilePath, [FilePath])]
svrobjs sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss sos :: [(FilePath, [(FilePath, [FilePath])])]
sos sdbn :: [(FilePath, [FilePath], FilePath)]
sdbn sor :: [(FilePath, FilePath, [FilePath])]
sor (obj :: JSObject JSValue
obj:t :: [JSObject JSValue]
t) = if ((FilePath, [FilePath], FilePath) -> Bool)
-> [(FilePath, [FilePath], FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) FilePath
name (FilePath -> Bool)
-> ((FilePath, [FilePath], FilePath) -> FilePath)
-> (FilePath, [FilePath], FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [FilePath], FilePath) -> FilePath
forall a b c. (a, b, c) -> a
fst3) [(FilePath, [FilePath], FilePath)]
sdbn then SchemaException
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])])
forall a e. Exception e => e -> a
throw SchemaException
SchemaDuplicateServerObjectException else [(FilePath, [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, FilePath, [FilePath])]
-> [JSObject JSValue]
-> ([(FilePath, [FilePath])],
    [(FilePath,
      [(FilePath, FilePath,
        [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])],
    [(FilePath, [(FilePath, [FilePath])])],
    [(FilePath, [FilePath], FilePath)],
    [(FilePath, FilePath, [FilePath])])
parsePrimitivesIterator ((FilePath
name,[FilePath]
pseudonyms)(FilePath, [FilePath])
-> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. a -> [a] -> [a]
:[(FilePath, [FilePath])]
svrobjs) ((FilePath
name,[(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
scalars)(FilePath,
 [(FilePath, FilePath,
   [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
forall a. a -> [a] -> [a]
:[(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss) ((FilePath
name,[(FilePath, [FilePath])]
nestedobjects)(FilePath, [(FilePath, [FilePath])])
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [(FilePath, [FilePath])])]
forall a. a -> [a] -> [a]
:[(FilePath, [(FilePath, [FilePath])])]
sos) ((FilePath
name,[FilePath]
uids,FilePath
table)(FilePath, [FilePath], FilePath)
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, [FilePath], FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, [FilePath], FilePath)]
sdbn) ([(FilePath, FilePath, [FilePath])]
sor[(FilePath, FilePath, [FilePath])]
-> [(FilePath, FilePath, [FilePath])]
-> [(FilePath, FilePath, [FilePath])]
forall a. [a] -> [a] -> [a]
++([[FilePath]] -> [(FilePath, FilePath, [FilePath])]
processRelationships [[FilePath]]
relationships)) [JSObject JSValue]
t
  where
    name :: FilePath
name = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ServerName" JSObject JSValue
obj :: Result String) 0
    pseudonyms :: [FilePath]
pseudonyms = Result [FilePath] -> Int -> [FilePath]
getStringList (FilePath -> JSObject JSValue -> Result [FilePath]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Pseudonyms" JSObject JSValue
obj :: Result [String]) 0
    scalars :: [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
scalars = [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
getScalars ([JSObject JSValue]
 -> [(FilePath, FilePath,
      [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
forall a b. (a -> b) -> a -> b
$ Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ScalarFields" JSObject JSValue
obj :: Result [JSObject JSValue])
    nestedobjects :: [(FilePath, [FilePath])]
nestedobjects = [JSObject JSValue] -> [(FilePath, [FilePath])]
getObjectFields ([JSObject JSValue] -> [(FilePath, [FilePath])])
-> [JSObject JSValue] -> [(FilePath, [FilePath])]
forall a b. (a -> b) -> a -> b
$ Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ObjectFields" JSObject JSValue
obj :: Result [JSObject JSValue])
    uids :: [FilePath]
uids = Result [FilePath] -> Int -> [FilePath]
getStringList (FilePath -> JSObject JSValue -> Result [FilePath]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "UniqueIds" JSObject JSValue
obj :: Result [String]) 2
    table :: FilePath
table = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "DatabaseTable" JSObject JSValue
obj :: Result String) 2
    relationships :: [[FilePath]]
relationships = Result [[FilePath]] -> [[FilePath]]
getListStringList (FilePath -> JSObject JSValue -> Result [[FilePath]]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "DatabaseRelationships" JSObject JSValue
obj :: Result [[String]])
parseParentsIterator :: [(String,[String],[String])] -> [JSObject JSValue] -> [(String,[String],[String])]
parseParentsIterator :: [(FilePath, [FilePath], [FilePath])]
-> [JSObject JSValue] -> [(FilePath, [FilePath], [FilePath])]
parseParentsIterator soa :: [(FilePath, [FilePath], [FilePath])]
soa (obj :: JSObject JSValue
obj:t :: [JSObject JSValue]
t) = if ((FilePath, [FilePath], [FilePath]) -> Bool)
-> [(FilePath, [FilePath], [FilePath])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) FilePath
name (FilePath -> Bool)
-> ((FilePath, [FilePath], [FilePath]) -> FilePath)
-> (FilePath, [FilePath], [FilePath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [FilePath], [FilePath]) -> FilePath
forall a b c. (a, b, c) -> a
fst3) [(FilePath, [FilePath], [FilePath])]
soa then SchemaException -> [(FilePath, [FilePath], [FilePath])]
forall a e. Exception e => e -> a
throw SchemaException
SchemaDuplicateInterfaceException else [(FilePath, [FilePath], [FilePath])]
-> [JSObject JSValue] -> [(FilePath, [FilePath], [FilePath])]
parseParentsIterator ((FilePath
name,[FilePath]
pseudonyms,[FilePath]
children)(FilePath, [FilePath], [FilePath])
-> [(FilePath, [FilePath], [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
forall a. a -> [a] -> [a]
:[(FilePath, [FilePath], [FilePath])]
soa) [JSObject JSValue]
t
  where
    name :: FilePath
name = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ServerName" JSObject JSValue
obj :: Result String) 0
    pseudonyms :: [FilePath]
pseudonyms = Result [FilePath] -> Int -> [FilePath]
getStringList (FilePath -> JSObject JSValue -> Result [FilePath]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Pseudonyms" JSObject JSValue
obj :: Result [String]) 0
    children :: [FilePath]
children = Result [FilePath] -> Int -> [FilePath]
getStringList (FilePath -> JSObject JSValue -> Result [FilePath]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ServerChildren" JSObject JSValue
obj :: Result [String]) 1
parseParentsIterator soa :: [(FilePath, [FilePath], [FilePath])]
soa [] = [(FilePath, [FilePath], [FilePath])]
soa
getObjects :: Result [JSObject JSValue] -> [JSObject JSValue]
getObjects :: Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (Ok objects :: [JSObject JSValue]
objects) = [JSObject JSValue]
objects
getObjects _ = SchemaException -> [JSObject JSValue]
forall a e. Exception e => e -> a
throw SchemaException
ReadJsonObjectsException
getString :: Result String -> Int -> String
getString :: Result FilePath -> Int -> FilePath
getString (Ok str :: FilePath
str) _ = FilePath
str
getString _ 0 = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadServerNameStringException
getString _ 1 = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadScalarFieldException
getString _ 2 = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadDatabaseTableException
getString _ _ = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadJsonStringException
getStringList :: Result [String] -> Int -> [String]
getStringList :: Result [FilePath] -> Int -> [FilePath]
getStringList (Ok rlt :: [FilePath]
rlt) _ = [FilePath]
rlt
getStringList _ 0 = SchemaException -> [FilePath]
forall a e. Exception e => e -> a
throw SchemaException
ReadPseudonymsException
getStringList _ 1 = SchemaException -> [FilePath]
forall a e. Exception e => e -> a
throw SchemaException
ReadInterfaceInstancesException
getStringList _ 2 = SchemaException -> [FilePath]
forall a e. Exception e => e -> a
throw SchemaException
ReadDatabaseIdsException
getStringList _ _ = SchemaException -> [FilePath]
forall a e. Exception e => e -> a
throw SchemaException
ReadJsonStringListException
getListStringList :: Result [[String]] -> [[String]]
getListStringList :: Result [[FilePath]] -> [[FilePath]]
getListStringList (Ok rlt :: [[FilePath]]
rlt) = [[FilePath]]
rlt
getListStringList _ = SchemaException -> [[FilePath]]
forall a e. Exception e => e -> a
throw SchemaException
ReadDatabaseRelationshipsException
checkScalars :: Result [JSObject JSValue] -> [(String,String,[(String,[(String,String,String,String)])])]
checkScalars :: Result [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
checkScalars = [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
getScalars ([JSObject JSValue]
 -> [(FilePath, FilePath,
      [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> (Result [JSObject JSValue] -> [JSObject JSValue])
-> Result [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result [JSObject JSValue] -> [JSObject JSValue]
getObjects
getScalars :: [JSObject JSValue] -> [(String,String,[(String,[(String,String,String,String)])])]
getScalars :: [JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
getScalars [] = []
getScalars (obj :: JSObject JSValue
obj:t :: [JSObject JSValue]
t) = (Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Name" JSObject JSValue
obj :: Result String) 1,Result FilePath -> FilePath
getType (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Type" JSObject JSValue
obj :: Result String),[JSObject JSValue]
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
getScalarArguments ([JSObject JSValue]
 -> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
-> [JSObject JSValue]
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
forall a b. (a -> b) -> a -> b
$ Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Arguments" JSObject JSValue
obj :: Result [JSObject JSValue]))(FilePath, FilePath,
 [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
forall a. a -> [a] -> [a]
:[JSObject JSValue]
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
getScalars [JSObject JSValue]
t
getScalarArguments :: [JSObject JSValue] -> [(String,[(String,String,String,String)])]
getScalarArguments :: [JSObject JSValue]
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
getScalarArguments [] = []
getScalarArguments (h :: JSObject JSValue
h:t :: [JSObject JSValue]
t) = (FilePath
name,[(FilePath, FilePath, FilePath, FilePath)]
options)(FilePath, [(FilePath, FilePath, FilePath, FilePath)])
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
forall a. a -> [a] -> [a]
:[JSObject JSValue]
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
getScalarArguments [JSObject JSValue]
t
  where
    name :: FilePath
name = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Name" JSObject JSValue
h :: Result String) 1
    options :: [(FilePath, FilePath, FilePath, FilePath)]
options = [JSObject JSValue] -> [(FilePath, FilePath, FilePath, FilePath)]
getScalarArgumentOptions (Result [JSObject JSValue] -> [JSObject JSValue]
getObjects (FilePath -> JSObject JSValue -> Result [JSObject JSValue]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Options" JSObject JSValue
h :: Result [JSObject JSValue]))
getScalarArgumentOptions :: [JSObject JSValue] -> [(String,String,String,String)]
getScalarArgumentOptions :: [JSObject JSValue] -> [(FilePath, FilePath, FilePath, FilePath)]
getScalarArgumentOptions (h :: JSObject JSValue
h:t :: [JSObject JSValue]
t) = (FilePath
name,FilePath
typ,FilePath
prefix,FilePath
suffix)(FilePath, FilePath, FilePath, FilePath)
-> [(FilePath, FilePath, FilePath, FilePath)]
-> [(FilePath, FilePath, FilePath, FilePath)]
forall a. a -> [a] -> [a]
:[JSObject JSValue] -> [(FilePath, FilePath, FilePath, FilePath)]
getScalarArgumentOptions [JSObject JSValue]
t
  where
    name :: FilePath
name = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Name" JSObject JSValue
h :: Result String) 1
    typ :: FilePath
typ = Result FilePath -> FilePath
getType (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Type" JSObject JSValue
h :: Result String)
    prefix :: FilePath
prefix = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Prefix" JSObject JSValue
h :: Result String) 1
    suffix :: FilePath
suffix = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Suffix" JSObject JSValue
h :: Result String) 1
getScalarArgumentOptions [] = []
getObjectFields :: [JSObject JSValue] -> [(String,[String])]
getObjectFields :: [JSObject JSValue] -> [(FilePath, [FilePath])]
getObjectFields (h :: JSObject JSValue
h:t :: [JSObject JSValue]
t) = (FilePath
obj, [FilePath]
names)(FilePath, [FilePath])
-> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. a -> [a] -> [a]
:[JSObject JSValue] -> [(FilePath, [FilePath])]
getObjectFields [JSObject JSValue]
t
  where
    obj :: FilePath
obj = Result FilePath -> Int -> FilePath
getString (FilePath -> JSObject JSValue -> Result FilePath
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "ServerName" JSObject JSValue
h :: Result String) 0
    names :: [FilePath]
names = Result [FilePath] -> Int -> [FilePath]
getStringList (FilePath -> JSObject JSValue -> Result [FilePath]
forall a. JSON a => FilePath -> JSObject JSValue -> Result a
valFromObj "Names" JSObject JSValue
h :: Result [String]) 0
getObjectFields [] = []
getType :: Result String -> String
getType :: Result FilePath -> FilePath
getType (Ok "Text") = "Text"
getType (Ok "Double") = "Double"
getType (Ok "Int64") = "Int64"
getType (Ok "Boolean") = "Boolean"
getType _ = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ScalarFieldDataTypeException
processRelationships :: [[String]] -> [(String,String,[String])]
processRelationships :: [[FilePath]] -> [(FilePath, FilePath, [FilePath])]
processRelationships = ([FilePath] -> (FilePath, FilePath, [FilePath]))
-> [[FilePath]] -> [(FilePath, FilePath, [FilePath])]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: [FilePath]
x->([FilePath] -> FilePath
getFirst [FilePath]
x,[FilePath] -> FilePath
getThird [FilePath]
x, [FilePath]
x))
getFirst :: [String] -> String
getFirst :: [FilePath] -> FilePath
getFirst (h :: FilePath
h:t :: [FilePath]
t) = FilePath
h
getFirst _ = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadDatabaseRelationshipsCardinalityException
getThird :: [String] -> String
getThird :: [FilePath] -> FilePath
getThird (h1 :: FilePath
h1:h2 :: FilePath
h2:h3 :: FilePath
h3:t :: [FilePath]
t) = FilePath
h3
getThird _ = SchemaException -> FilePath
forall a e. Exception e => e -> a
throw SchemaException
ReadDatabaseRelationshipsCardinalityException
-- no duplicated names in schema
isWithoutDups :: [(String,[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[(String,[String])])] -> [(String,String,[String])] -> [(String,[String],[String])] -> Bool
isWithoutDups :: [(FilePath, [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, FilePath, [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
-> Bool
isWithoutDups sobjs :: [(FilePath, [FilePath])]
sobjs sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss sos :: [(FilePath, [(FilePath, [FilePath])])]
sos sor :: [(FilePath, FilePath, [FilePath])]
sor soa :: [(FilePath, [FilePath], [FilePath])]
soa = ([FilePath] -> Bool
isNoDupsNames ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a] -> [a]
(++) (((FilePath, [FilePath]) -> [FilePath])
-> [(FilePath, [FilePath])] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd [(FilePath, [FilePath])]
sobjs) ([[FilePath]] -> [[FilePath]]) -> [[FilePath]] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ ((FilePath, [FilePath], [FilePath]) -> [FilePath])
-> [(FilePath, [FilePath], [FilePath])] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [FilePath], [FilePath]) -> [FilePath]
forall a b c. (a, b, c) -> b
snd3 [(FilePath, [FilePath], [FilePath])]
soa)Bool -> Bool -> Bool
&&([(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isNoDupsScalars [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss)Bool -> Bool -> Bool
&&([(FilePath, [(FilePath, [FilePath])])] -> Bool
isNoDupsNestedObjects [(FilePath, [(FilePath, [FilePath])])]
sos)Bool -> Bool -> Bool
&&([(FilePath, FilePath, [FilePath])] -> Bool
isNoDupsRelationships [(FilePath, FilePath, [FilePath])]
sor)
isNoDupsNames :: [String] -> Bool
isNoDupsNames :: [FilePath] -> Bool
isNoDupsNames (nm :: FilePath
nm:rst :: [FilePath]
rst) = (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
nm [FilePath]
rstBool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
False)Bool -> Bool -> Bool
&&[FilePath] -> Bool
isNoDupsNames [FilePath]
rst
isNoDupsNames [] = Bool
True
isNoDupsScalars :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool
isNoDupsScalars :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isNoDupsScalars = ((FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
 -> Bool)
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> Bool
isNoDupsScalarNames ([(FilePath, FilePath,
   [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
 -> Bool)
-> ((FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
    -> [(FilePath, FilePath,
         [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> (FilePath,
    [(FilePath, FilePath,
      [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath,
 [(FilePath, FilePath,
   [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
forall a b. (a, b) -> b
snd)
isNoDupsScalarNames :: [(String,String,[(String,[(String,String,String,String)])])] -> Bool
isNoDupsScalarNames :: [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> Bool
isNoDupsScalarNames ((name :: FilePath
name,_,args :: [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
args):rst :: [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
rst) = (((FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
 -> Bool)
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(/=) FilePath
name (FilePath -> Bool)
-> ((FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
    -> FilePath)
-> (FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath,
 [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
-> FilePath
forall a b c. (a, b, c) -> a
fst3) [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
rst)Bool -> Bool -> Bool
&&([(FilePath, [(FilePath, FilePath, FilePath, FilePath)])] -> Bool
isNoDupsScalarArguments [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
args)Bool -> Bool -> Bool
&&[(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> Bool
isNoDupsScalarNames [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
rst
isNoDupsScalarNames [] = Bool
True
isNoDupsScalarArguments :: [(String,[(String,String,String,String)])] -> Bool
isNoDupsScalarArguments :: [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])] -> Bool
isNoDupsScalarArguments ((name :: FilePath
name,opts :: [(FilePath, FilePath, FilePath, FilePath)]
opts):rst :: [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
rst) = (((FilePath, [(FilePath, FilePath, FilePath, FilePath)]) -> Bool)
-> [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(n :: FilePath
n,o :: [(FilePath, FilePath, FilePath, FilePath)]
o)->FilePath
nFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/=FilePath
nameBool -> Bool -> Bool
&&[(FilePath, FilePath, FilePath, FilePath)] -> Bool
isNoDupsArgumentOptions [(FilePath, FilePath, FilePath, FilePath)]
o) [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
rst)Bool -> Bool -> Bool
&&[(FilePath, [(FilePath, FilePath, FilePath, FilePath)])] -> Bool
isNoDupsScalarArguments [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])]
rst
isNoDupsScalarArguments [] = Bool
True
isNoDupsArgumentOptions :: [(String,String,String,String)] -> Bool
isNoDupsArgumentOptions :: [(FilePath, FilePath, FilePath, FilePath)] -> Bool
isNoDupsArgumentOptions ((name :: FilePath
name,_,_,_):rst :: [(FilePath, FilePath, FilePath, FilePath)]
rst) = (((FilePath, FilePath, FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath, FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(/=) FilePath
name (FilePath -> Bool)
-> ((FilePath, FilePath, FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath, FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath, FilePath, FilePath) -> FilePath
forall a b c d. (a, b, c, d) -> a
fst4) [(FilePath, FilePath, FilePath, FilePath)]
rst)Bool -> Bool -> Bool
&&[(FilePath, FilePath, FilePath, FilePath)] -> Bool
isNoDupsArgumentOptions [(FilePath, FilePath, FilePath, FilePath)]
rst
isNoDupsArgumentOptions [] = Bool
True
isNoDupsNestedObjects :: [(String,[(String,[String])])] -> Bool
isNoDupsNestedObjects :: [(FilePath, [(FilePath, [FilePath])])] -> Bool
isNoDupsNestedObjects ((_,[]):rst :: [(FilePath, [(FilePath, [FilePath])])]
rst) = [(FilePath, [(FilePath, [FilePath])])] -> Bool
isNoDupsNestedObjects [(FilePath, [(FilePath, [FilePath])])]
rst
isNoDupsNestedObjects ((obj :: FilePath
obj,(no :: FilePath
no,nms :: [FilePath]
nms):objs :: [(FilePath, [FilePath])]
objs):rst :: [(FilePath, [(FilePath, [FilePath])])]
rst) = Bool
noDupObjBool -> Bool -> Bool
&&Bool
noDupNmsBool -> Bool -> Bool
&&[(FilePath, [(FilePath, [FilePath])])] -> Bool
isNoDupsNestedObjects ((FilePath
obj,[(FilePath, [FilePath])]
objs)(FilePath, [(FilePath, [FilePath])])
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [(FilePath, [FilePath])])]
forall a. a -> [a] -> [a]
:[(FilePath, [(FilePath, [FilePath])])]
rst)
  where
    noDupObj :: Bool
noDupObj = ((FilePath, [FilePath]) -> Bool)
-> [(FilePath, [FilePath])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(/=) FilePath
no (FilePath -> Bool)
-> ((FilePath, [FilePath]) -> FilePath)
-> (FilePath, [FilePath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [FilePath]) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, [FilePath])]
objs
    noDupNms :: Bool
noDupNms = [FilePath] -> Bool
isNoDupsNames [FilePath]
nms
isNoDupsNestedObjects [] = Bool
True
isNoDupsRelationships :: [(String,String,[String])] -> Bool
isNoDupsRelationships :: [(FilePath, FilePath, [FilePath])] -> Bool
isNoDupsRelationships ((from :: FilePath
from,to :: FilePath
to,_):rst :: [(FilePath, FilePath, [FilePath])]
rst) = (((FilePath, FilePath, [FilePath]) -> Bool)
-> [(FilePath, FilePath, [FilePath])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(a :: FilePath
a,b :: FilePath
b,_)->FilePath
fromFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/=FilePath
aBool -> Bool -> Bool
||FilePath
toFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/=FilePath
b) [(FilePath, FilePath, [FilePath])]
rst)Bool -> Bool -> Bool
&&[(FilePath, FilePath, [FilePath])] -> Bool
isNoDupsRelationships [(FilePath, FilePath, [FilePath])]
rst
isNoDupsRelationships [] = Bool
True
-- shared scalars are same type
isValidParentScalars :: [(String,[String],[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool
isValidParentScalars :: [(FilePath, [FilePath], [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidParentScalars ((_,_,(h :: FilePath
h:nxt :: FilePath
nxt:cld :: [FilePath]
cld)):t :: [(FilePath, [FilePath], [FilePath])]
t) sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss = ([(FilePath, FilePath)]
-> [FilePath]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidScalarsType (FilePath
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, FilePath)]
getPrimitiveScalars FilePath
h [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss) (FilePath
nxtFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
cld) [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss)Bool -> Bool -> Bool
&&[(FilePath, [FilePath], [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidParentScalars [(FilePath, [FilePath], [FilePath])]
t [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss
isValidParentScalars ((_,_,_:[]):t :: [(FilePath, [FilePath], [FilePath])]
t) sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss = [(FilePath, [FilePath], [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidParentScalars [(FilePath, [FilePath], [FilePath])]
t [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss
isValidParentScalars ((_,_,[]):t :: [(FilePath, [FilePath], [FilePath])]
t) sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss = [(FilePath, [FilePath], [FilePath])]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidParentScalars [(FilePath, [FilePath], [FilePath])]
t [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss
isValidParentScalars [] _ = Bool
True
getPrimitiveScalars :: String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,String)]
getPrimitiveScalars :: FilePath
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, FilePath)]
getPrimitiveScalars name :: FilePath
name ((nm :: FilePath
nm,st :: [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
st):t :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
t) = if FilePath
nameFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
nm then ((FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])
 -> (FilePath, FilePath))
-> [(FilePath, FilePath,
     [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
-> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: FilePath
n,tp :: FilePath
tp,_)->(FilePath
n,FilePath
tp)) [(FilePath, FilePath,
  [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])]
st else FilePath
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, FilePath)]
getPrimitiveScalars FilePath
name [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
t
getPrimitiveScalars _ [] = SchemaException -> [(FilePath, FilePath)]
forall a e. Exception e => e -> a
throw SchemaException
PrimaryObjectNotFoundException
isValidScalarsType :: [(String,String)] -> [String] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool
isValidScalarsType :: [(FilePath, FilePath)]
-> [FilePath]
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> Bool
isValidScalarsType ((name :: FilePath
name,typ :: FilePath
typ):t :: [(FilePath, FilePath)]
t) cld :: [FilePath]
cld sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\chld :: FilePath
chld->((FilePath, FilePath) -> Bool) -> [(FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(n :: FilePath
n,tp :: FilePath
tp)->(FilePath
nFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
nameBool -> Bool -> Bool
&&FilePath
tpFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
typ)Bool -> Bool -> Bool
||FilePath
nFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/=FilePath
name) ([(FilePath, FilePath)] -> Bool) -> [(FilePath, FilePath)] -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, FilePath)]
getPrimitiveScalars FilePath
chld [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss) [FilePath]
cld
isValidScalarsType [] _ _ = Bool
True