changed compiler to whole folder

.gitignore

@@ -26,4 +26,5 @@ cabal.project.local~
 .vscode/
 /resources/Rosetta/Try/
 /resources/fxspot.json
-/resources/european contract.json
+/resources/european contract.json
+/resources/CDM/

RosettaParser.cabal

@@ -53,6 +53,8 @@ library
       src
   build-depends:
       base >=4.7 && <5
+    , directory
+    , filepath
     , megaparsec
     , mtl
     , parser-combinators
@@ -69,6 +71,8 @@ executable RosettaParser-exe
   build-depends:
       RosettaParser
     , base >=4.7 && <5
+    , directory
+    , filepath
     , megaparsec
     , mtl
     , parser-combinators
@@ -93,6 +97,8 @@ test-suite RosettaParser-test
   build-depends:
       RosettaParser
     , base >=4.7 && <5
+    , directory
+    , filepath
     , hspec
     , hspec-megaparsec
     , megaparsec

app/Main.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
 import Parser.Enum
@@ -15,6 +17,7 @@ import Semantic.TypeChecker
 import Semantic.ExpressionChecker
 import Semantic.FunctionChecker
 import Model.Type
+import Model.Function
 import System.Environment.Blank (getArgs)
 import Model.Enum
 import Data.Either
@@ -23,63 +26,125 @@ import Parser.Header
 import PrettyPrinter.Header
 import Data.Tuple (fst, snd)
 import Data.Void
+import System.FilePath
 import Utils.Utils
+import System.Directory
+import Data.List
 import Data.Text (Text)
 import Parser.Expression (expressionParser)
--- :l resources/Generated/ContractDSL.hs resources/Generated/ImportsTypes.hs resources/Generated/ImportsEnums.hs
+-- :l resources/Generated/ContractDSL.hs resources/Generated/ImportsType.hs resources/Generated/ImportsEnum.hs
--- :set args resources/Rosetta/Contracts/contractDSL.rosetta
+-- :set args resources/Rosetta/Contracts/
+-- :set args resources/CDM/
 
 -- |Reads a rosetta string from the first input argument and writes a haskell output to the file given as a second argument
 main :: IO ()
 main = do
     args <- getArgs
-    let mainFile = head args
+    let mainFolder = head args
-    parseResult <- parseWithImport mainFile
+    files <- getDirectoryContents mainFolder
-    let checked = checkObjects parseResult
+    parseResult <- parseFolder [mainFolder ++ f | f <- files, f `notElem` [".", ".."]]
+    let completeFiles = [createSymbolTable f parseResult | f <- parseResult]
+    let checked = checkObjects completeFiles
     let headers = fstlst checked
     let objects = nestedRights $ sndlst checked
+    --_ <- error $ show [(map typeName t, map symbolName s) | (path, t, s, (head, obj)) <- completeFiles, path == "resources/Rosetta/Contracts/contractDSL.rosetta"]
     if null $ lefts $ concat $ sndlst checked
         then
             let input = pairRights checked in
                 mapM_ generateFile input
         else error $ show $ lefts $ concat $ sndlst checked
 
-{- |Recursively parse a file and all the imports into a list of headers and objects
+{- | Parse the contents of a folder, skip any files without the Rosetta extension
-The first argument is the default directory, second argument is the file name
+Return a list of Header, Rosettaobject, filename pairs  
 -}
-parseWithImport :: String -> IO [(([Type], [Symbol]), (Header, [RosettaObject]))]
+parseFolder :: [FilePath] -> IO [(FilePath, Header, [RosettaObject])]
-parseWithImport file =
+parseFolder [] = return []
+parseFolder (file : files) = do
+    plain <- readFile file
+    rest <- parseFolder files
+    case parseFile plain of
+        Left errorBundle -> error $ errorBundlePretty errorBundle ++ " on file " ++ file
+        Right (header, objs) ->
+            return ((file, header, objs) : rest)
+
+-- | Create the symbol table for each file from the imported types enums and functions
+createSymbolTable :: (FilePath, Header, [RosettaObject]) ->  [(FilePath, Header, [RosettaObject])] -> (FilePath, [Type], [Symbol], (Header, [RosettaObject]))
+createSymbolTable (file, MakeHeader name desc ver imp, objs) imps =
+        (file, concat (fstlst imports), concat (sndlst imports), (MakeHeader name desc ver actualImport, objs))
+        where
+            imports = [(getTypes imObjs, getFunctions imObjs) | (_, MakeHeader imName _ _ _, imObjs) <- imps, imName `elem` map getNamespace imp || imName == name]
+            actualImport = 
+                [removeChar (takeFileName (dropExtension p)) '-' | (p, MakeHeader imName _ _ _, imObjs) <- imps, imName `elem` map getNamespace imp 
+                || (imName == name && p /= file && not ("enum.rosetta" `isSuffixOf` file) && not ("type.rosetta" `isSuffixOf` file && "func.rosetta" `isSuffixOf` p))]
+
+-- |Get the defined data types from a list of rosetta objects
+getTypes :: [RosettaObject] -> [Type]
+getTypes [] = []
+getTypes (TypeObject o : os) = o{typeAttributes = map convertAttributeType (typeAttributes o)} : getTypes os
+getTypes (EnumObject o : os) = convertEnumToType o : getTypes os
+getTypes (FunctionObject o : os) = getTypes os
+
+convertAttributeType :: TypeAttribute -> TypeAttribute
+convertAttributeType (MakeTypeAttribute n (MakeType "int" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Integer") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "string" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "String") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "number" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Double") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "boolean" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Bool") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "time" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Time") c d
+convertAttributeType t = t
+
+getFunctions :: [RosettaObject] -> [Symbol]
+getFunctions [] = []
+getFunctions (FunctionObject o : os) = functionToSymbol o : getFunctions os
+getFunctions (o : os) = getFunctions os
+
+functionToSymbol :: Function -> Symbol
+functionToSymbol (MakeFunction (MakeFunctionSignature name _ inp out) _ _) = Func name [(attributeType (convertAttributeType i), Model.Type.cardinality i)| i <- inp] (attributeType out, Model.Type.cardinality out)
+
+{- |Recursively parse a file and all the imports into a list of headers and objects
+The first argument is a list of files already parsed (to handle cyclic imports) and the second is the name of the file to be parsed
+-}
+parseWithImport :: [String] -> String -> IO [(([Type], [Symbol]), (Header, [RosettaObject]))]
+parseWithImport files file
+    | file `elem` files = error $ "cyclic dependency on " ++ file
+    | otherwise =
     do
         plain <- readFile file
         case parseFile plain of
             Left errorBundle -> error $ errorBundlePretty errorBundle ++ "on file" ++ file
             Right (MakeHeader name desc vers imp, objs) ->
                 do
-                    let files = map ((++) (fileDirectory file) . namespaceToName) imp
+                    let modules = map namespaceToName imp
-                    imports <- mapM parseWithImport files
+                    importFiles <- getFiles modules
+                    imports <- mapM (parseWithImport (file : files)) importFiles
                     let importedSymbolTable = fstlst (concat imports)
                     let importedTypes = concat $ fstlst importedSymbolTable
                     let importedFunctions = concat $ sndlst importedSymbolTable
                     case addNewTypes importedTypes objs of
-                        Left errors -> error $ show errors
+                        Left errors -> error $ show errors ++ "\n on file " ++ file
                         Right definedTypes -> case addNewFunctions (definedTypes, importedFunctions) objs of
-                            Left errors -> error $ show errors
+                            Left errors -> error $ show errors ++ "\n on file " ++ file
                             Right definedFunctions -> return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports
 
+
+getFiles :: [String] -> IO [String]
+getFiles [] = return []
+getFiles (n : ns)
+    | ".*" `isSuffixOf` n = do
+        files <- getDirectoryContents $ takeDirectory n
+        rest <- getFiles ns
+        return $ [f | f <- files, dropExtension n `isPrefixOf` f] ++ rest
+    | otherwise = do
+        files <- getFiles ns
+        return (n : files)
+
 -- |Parse a file into a list of RosettaObjects
 parseFile :: String -> Either (ParseErrorBundle Text Void) (Header, [RosettaObject])
 parseFile plainText = parse rosettaParser "" (Text.pack plainText)
 
--- |Converts a RosettaObject into a plain haskell string
--- printObject :: CheckedRosettaObject -> String
--- printObject (CheckedTypeObject t) = printType t
--- printObject (CheckedFunctionObject f) = printFunction f
--- printObject (CheckedEnumObject e) = printEnum e
-
 -- |Checks all the objects from a list
-checkObjects :: [(([Type], [Symbol]), (Header, [RosettaObject]))] -> [(Header, [Either [TypeCheckError] CheckedRosettaObject])]
+checkObjects :: [(FilePath, [Type], [Symbol], (Header, [RosettaObject]))] -> [((FilePath, Header), [Either [TypeCheckError] CheckedRosettaObject])]
 checkObjects [] = []
-checkObjects (((definedTypes, definedSymbols), (header, objs)) : rest) = (header, checked) : checkObjects rest
+checkObjects ((file, definedTypes, definedSymbols, (header, objs)) : rest) = ((file, header), checked) : checkObjects rest
     where
         checked = map (checkObject (definedTypes, definedSymbols)) objs
 
@@ -110,7 +175,7 @@ addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
 -- |Adds new defined types into the symbol table
 addNewTypes :: [Type] -> [RosettaObject] -> Either [TypeCheckError] [Type]
 addNewTypes l [] = Right l
-addNewTypes defined (TypeObject o: os) = 
+addNewTypes defined (TypeObject o: os) =
     case addNewTypes defined os of
         Left errors -> Left errors
         Right types -> addDefinedTypes types [o]
@@ -140,5 +205,7 @@ parseFunction = do
     FunctionObject <$> functionParser
 
 -- |Generate a new haskell file based on the rosetta objects and header
-generateFile :: (Header, [CheckedRosettaObject]) -> IO ()
+generateFile :: ((FilePath, Header), [CheckedRosettaObject]) -> IO ()
-generateFile (header, objects) = writeFile (haskellFileName $ namespace header) (printHeader header ++ concatMap printRosettaObject objects)
+generateFile ((path, header), objects) =
+    writeFile (haskellFileName $ dropExtension $ takeFileName path)
+    (printHeader (dropExtension $ takeFileName path) header ++ concatMap printRosettaObject objects)

package.yaml

@@ -27,6 +27,8 @@ dependencies:
 - prettyprinter
 - parser-combinators
 - text
+- filepath
+- directory
 
 library:
   source-dirs: src

resources/Rosetta/Contracts/contractDSL.rosetta

@@ -1,8 +1,7 @@
 namespace contractDSL : <"Generic product concepts: quantity, price, economic terms and payout, that are built using template features.">
 version "${project.version}"
 
-import imports.types.*
+import imports.*
-import imports.enums.*
 
 
 type Obs:

resources/Rosetta/Contracts/imports-enum.rosetta

@@ -0,0 +1,6 @@
+namespace imports : <"Enums used for the contract dsl">
+version "${version.ok}"
+
+enum CounterpartyRoleEnum:
+	Party1
+	Party2

resources/Rosetta/Contracts/imports-type.rosetta

@@ -0,0 +1,105 @@
+namespace imports : <"Types used for the contract dsl">
+version "${version.ok}"
+
+type Product:
+	contractualProduct	ContractualProduct	(0..1)
+	foreignExchange 	ForeignExchange 	(0..1)
+	
+	condition: one-of
+
+type Trade:
+	tradableProduct 	TradableProduct 	(1..1)
+
+type TradableProduct:
+	product 	Product		(1..1)
+	tradeLot	TradeLot	(1..*)
+	
+type TradeLot:
+    priceQuantity     PriceQuantity     (1..*)
+
+type PriceQuantity:
+    quantity        Quantity            (0..*)
+
+type SettlementTerms:
+    settlementDate      SettlementDate      (0..1)
+    cashSettlementTerms CashSettlementTerms (0..*)
+    settlementCurrency  string              (0..1)
+    unitType            UnitType            (1..1)
+
+type CashSettlementTerms:
+    valuationDate ValuationDate (1..1)
+
+type ValuationDate:
+    fxFixingDate    FxFixingDate    (1..1)
+
+type FxFixingDate:
+    fxFixingDate    AdjustableOrRelativeDate (1..1)
+
+type SettlementDate:
+    valueDate   string  (1..1) 
+
+type ContractualProduct:
+    economicTerms     EconomicTerms     (1..1)
+
+type EconomicTerms:
+    payout Payout (1..1)
+
+type Payout:
+    optionPayout OptionPayout (0..*)
+    forwardPayout ForwardPayout (0..*)
+    cashflow    Cashflow (0..*)
+
+type OptionPayout:
+    exerciseTerms   OptionExercise  (1..1)
+    underlier       Product         (1..1)
+    settlementTerms SettlementTerms (0..1) 
+
+type OptionExercise:
+    optionStyle     OptionStyle     (1..1)
+
+type OptionStyle:
+	europeanExercise EuropeanExercise (0..1)
+	
+    condition: one-of
+
+type EuropeanExercise:
+    expirationDate AdjustableOrRelativeDate (1..*)
+
+type AdjustableOrRelativeDate:
+    adjustableDate AdjustableDate (0..1)
+
+type AdjustableDate:
+    adjustedDate    string  (0..1)
+    unadjustedDate  string  (0..1)
+
+type ForwardPayout:
+    settlementTerms     SettlementTerms     (1..1)
+    underlier           Product             (1..1)
+
+type ForeignExchange:
+    exchangedCurrency1      Cashflow     (1..1)
+    exchangedCurrency2      Cashflow     (1..1)
+
+type Cashflow extends PayoutBase:
+    payoutQuantity  ResolvablePayoutQuantity (1..1)
+
+type ResolvablePayoutQuantity:
+    resolvedQuantity    Quantity    (1..1)
+
+type Quantity:
+    multiplier      number          (0..1)
+    location        Address         (0..1)
+    unitOfAmount    UnitType        (0..1)
+
+type Address:
+    street          string          (1..1)
+
+type UnitType:
+    currency        string          (0..1)
+
+type PayoutBase:
+    payerReceiver  PayerReceiver    (1..1)
+
+type PayerReceiver:
+    payer       CounterpartyRoleEnum    (1..1)
+    receiver    CounterpartyRoleEnum    (1..1)

resources/bkup/contractDSL.rosetta

@@ -0,0 +1,416 @@
+namespace contractDSL : <"Generic product concepts: quantity, price, economic terms and payout, that are built using template features.">
+version "${project.version}"
+
+import imports.types.*
+import imports.enums.*
+
+
+type Obs:
+  constant number (0..1)
+  exchangeRate ExchangeRate (0..1)
+  condition: one-of
+
+type ExchangeRate:
+  from UnitType (1..1)
+  to UnitType (1..1)
+
+func Konst:
+  inputs:
+    constant number (1..1)
+  output:
+    observable Obs (1..1)
+  assign-output observable -> constant:
+    constant
+
+func ExchangeRateFunc:
+  inputs:
+    from UnitType (1..1)
+    to   UnitType (1..1)
+  output:
+    observable Obs (1..1)
+  assign-output observable -> exchangeRate -> from:
+    from
+  assign-output observable -> exchangeRate -> to:
+    to
+
+type Contract:
+  zero       Contract_Zero       (0..1)
+  expired    Contract_Expired    (0..1)
+  one        Contract_One        (0..1)
+  orContract Contract_Or         (0..1)
+  both       Contract_Both       (0..1)
+  give       Contract_Give       (0..1)
+  thereafter Contract_Thereafter (0..1)
+  truncate   Contract_Truncate   (0..1)
+  scale      Contract_Scale      (0..1)
+  get        Contract_Get        (0..1)
+  anytime    Contract_Anytime    (0..1)
+  condition: one-of
+
+type Contract_Zero:
+   unit int (1..1)
+type Contract_Expired:
+   unit int (1..1)
+type Contract_One:
+  currency UnitType (1..1)
+type Contract_Or:
+  left Contract (1..1)
+  right Contract (1..1)
+type Contract_Both:
+  left Contract (1..1)
+  right Contract (1..1)
+type Contract_Thereafter:
+  earlier Contract (1..1)
+  later   Contract (1..1)
+type Contract_Give:
+  contract Contract (1..1)
+type Contract_Truncate:
+  expiryDate string    (1..1)
+  contract   Contract (1..1)
+type Contract_Scale:
+  observable Obs (1..1)
+  contract Contract (1..1)
+type Contract_Get:
+  contract Contract (1..1)
+type Contract_Anytime:
+  contract Contract (1..1)
+
+func MkZero:
+  output:
+    contract Contract (1..1)
+  assign-output contract -> zero -> unit:
+    1 // create the zero contract dummy value
+
+func MkExpired:
+  output:
+    contract Contract (1..1)
+  assign-output contract -> expired -> unit:
+    1 // create the expired contract dummy value
+
+func MkOne:
+  inputs:
+    currency UnitType (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> one -> currency:
+    currency
+
+func MkOr:
+  inputs:
+    left  Contract (1..1)
+    right Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> orContract -> left:
+    left
+  assign-output contract -> orContract -> right:
+    right
+
+func MkBoth:
+  inputs:
+    left  Contract (1..1)
+    right Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> both -> left:
+    left
+  assign-output contract -> both -> right:
+    right
+
+func MkThereafter:
+  inputs:
+    earlier  Contract (1..1)
+    later Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> thereafter -> earlier:
+    earlier
+  assign-output contract -> thereafter -> later:
+    later
+
+func MkGive:
+  inputs:
+    subContract Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> give -> contract:
+    subContract
+
+func MkTruncate:
+  inputs:
+    truncateTo string     (1..1)
+    subContract Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> truncate -> contract:
+    subContract
+  assign-output contract -> truncate -> expiryDate:
+    truncateTo
+
+func MkScale:
+  inputs:
+    observable Obs (1..1)
+    subContract Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> scale -> contract:
+    subContract
+  assign-output contract -> scale -> observable:
+    observable
+
+func MkGet:
+  inputs:
+    subContract Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> get -> contract:
+    subContract
+
+func MkAnytime:
+  inputs:
+    subContract Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract -> anytime -> contract:
+    subContract
+
+func MkAnd:
+  inputs:
+    left Contract (1..1)
+    right Contract (1..1)
+  output:
+    contract Contract (1..1)
+  assign-output contract:
+    MkThereafter(MkBoth(left,right),MkOr(left,right))
+
+func ZeroCouponBond:
+  inputs:
+    maturesOn string   (1..1)  <"Date the bond matures on">
+    amount number     (1..1)  <"Amount of the bond is worth">
+    currency UnitType (1..1)  <"Unit the bond is denoted in">
+  output:
+    contract Contract (1..1)
+  assign-output contract:
+    MkGet (MkTruncate(maturesOn, MkScale(Konst(amount),MkOne(currency))))
+
+func Perhaps:
+  inputs:
+    endDate  string    (1..1)
+    contract Contract (1..1)
+  output:
+    perhaps Contract (1..1)
+  assign-output perhaps:
+    MkTruncate(endDate,MkOr(contract,MkZero()))
+
+func EuropeanOption:
+  inputs:
+    endDate  string    (1..1)
+    contract Contract (1..1)
+  output:
+    option Contract (1..1)
+
+  assign-output option:
+    MkGet(Perhaps(endDate,contract))
+
+func AmericanOption:
+  inputs:
+    startDate string   (1..1)
+    endDate   string   (1..1)
+    contract Contract (1..1)
+  output:
+    option Contract (1..1)
+  alias opt: MkAnytime(Perhaps(endDate,contract))
+  assign-output option:
+    MkThereafter(MkGet (MkTruncate(startDate,opt)),opt)
+
+/* Swap the parties of a contract based on the party of a payout. Assuming we are Party1 */
+func PayoutParty1:
+  inputs:
+    payout PayoutBase (1..1)
+    contract Contract (1..1)
+  output:
+    contractOut Contract (1..1)
+  assign-output contractOut:
+    if (payout -> payerReceiver -> payer = CounterpartyRoleEnum -> Party1)
+    or (payout -> payerReceiver -> receiver = CounterpartyRoleEnum -> Party2) then
+      MkGive(contract)
+    else
+      contract
+
+
+func ResolveQuantity:
+  inputs:
+    address Address (1..1)
+    tradeLot TradeLot (1..*)
+  output:
+    resolvedQuantity Quantity (1..1)
+
+  alias resolvedValue:
+    tradeLot
+    map [item -> priceQuantity]
+    flatten
+    map [item -> quantity]
+    flatten
+    filter [item -> location = address]
+    only-element
+
+  assign-output resolvedQuantity -> multiplier:
+    resolvedValue -> multiplier
+
+  assign-output resolvedQuantity -> unitOfAmount:
+    resolvedValue -> unitOfAmount
+
+func CashflowPayoutToContract:
+  inputs:
+    cashflow Cashflow (1..1)
+    tradeLot TradeLot (1..*)
+    settlementTerms SettlementTerms (0..1)
+  output:
+    zcb Contract (1..1)
+
+  alias quantity:
+    ResolveQuantity(cashflow -> payoutQuantity -> resolvedQuantity -> location only-element, tradeLot)
+
+  alias fixingDate:
+    if settlementTerms -> cashSettlementTerms exists then
+      settlementTerms
+      -> cashSettlementTerms
+      only-element
+      -> valuationDate
+      -> fxFixingDate
+      -> fxFixingDate
+      -> adjustableDate
+      -> unadjustedDate
+    else
+      empty
+
+  assign-output zcb:
+    PayoutParty1
+    ( cashflow
+    , MkScale
+      ( Konst (quantity -> multiplier only-element)
+      , if fixingDate exists then
+          MkGet
+          ( MkTruncate
+            ( fixingDate only-element
+            , MkScale
+              ( ExchangeRateFunc(quantity -> unitOfAmount only-element, settlementTerms -> unitType)
+              , MkGet
+                ( MkTruncate
+                  ( settlementTerms -> settlementDate -> valueDate
+                  , MkOne (settlementTerms -> unitType)
+                  )
+                )
+              )
+            )
+          )
+        else
+          MkOne(quantity -> unitOfAmount only-element))
+    )
+
+
+func ForeignExchangeToContract:
+  inputs:
+    foreignExchange ForeignExchange (1..1)
+    tradeLot TradeLot (1..*)
+    settlementTerms SettlementTerms (0..1)
+  output:
+    contract Contract (1..1)
+
+  assign-output contract:
+    MkBoth
+      ( CashflowPayoutToContract(foreignExchange -> exchangedCurrency1, tradeLot, settlementTerms)
+      , CashflowPayoutToContract(foreignExchange -> exchangedCurrency2, tradeLot, settlementTerms)
+      )
+
+func ForwardPayoutToContract:
+  inputs:
+    fx                    ForwardPayout (1..1)
+    tradeLot              TradeLot (1..*)
+  output:
+    contract Contract (1..1)
+  assign-output contract:
+    MkGet
+      ( MkTruncate
+          ( fx -> settlementTerms -> settlementDate -> valueDate
+          , ForeignExchangeToContract
+              ( fx -> underlier -> foreignExchange  
+              , tradeLot
+              , fx -> settlementTerms
+              )
+          )
+      )
+
+func OptionPayoutToEuropean:
+  inputs:
+    optionPayout OptionPayout (1..1)
+    tradeLot     TradeLot     (1..*)
+  output:
+    contract Contract (1..1)
+
+  alias europeanExerciseTerms:
+    optionPayout -> exerciseTerms -> optionStyle -> europeanExercise
+  alias adjustedExpirationDate:
+    europeanExerciseTerms -> expirationDate only-element -> adjustableDate -> adjustedDate
+
+  assign-output contract:
+    EuropeanOption
+      ( adjustedExpirationDate only-element
+        // The cardinality on europeanExerciseTerms -> expirationDate is not (1..1)!
+      , ProductToContract(optionPayout -> underlier, tradeLot, optionPayout -> settlementTerms)
+      , optionPayout -> settlementTerms
+      )
+
+func ContractualProductToContract:
+  inputs:
+    contractualProduct ContractualProduct (1..1)
+    tradeLot           TradeLot           (1..*)
+    settlementTerms    SettlementTerms    (0..1)
+  output:
+    contract Contract (1..1)
+  alias payout: contractualProduct -> economicTerms -> payout
+  assign-output contract:
+    if payout -> optionPayout exists then
+      payout
+      -> optionPayout
+      map [OptionPayoutToEuropean(item,tradeLot)]
+      reduce c1 c2 [MkBoth(c1,c2)]
+
+    else if payout -> forwardPayout exists then
+      payout
+      -> forwardPayout
+      map [ForwardPayoutToContract(item,tradeLot)]
+      reduce c1 c2 [MkBoth(c1,c2)]
+
+    else /* assume cashflow otherwise */
+      payout
+      -> cashflow
+      map [CashflowPayoutToContract(item,tradeLot,settlementTerms)]
+      reduce c1 c2 [MkBoth(c1,c2)]
+
+
+func ProductToContract:
+  inputs:
+    product         Product         (1..1)
+    tradeLot        TradeLot        (1..*)
+    settlementTerms SettlementTerms (0..1)
+  output:
+    contract Contract (1..1)
+
+  assign-output contract:
+    if product -> contractualProduct exists then
+      ContractualProductToContract(product -> contractualProduct, tradeLot, settlementTerms)
+    else if product -> foreignExchange exists then
+      ForeignExchangeToContract(product -> foreignExchange, tradeLot, settlementTerms)
+    else
+      MkZero()
+
+func Main:
+  inputs:
+    //meta MetaData (1..1)
+    trade Trade (1..1)
+  output:
+    contract Contract (1..1)
+
+ assign-output contract:
+   ProductToContract(trade -> tradableProduct -> product, trade -> tradableProduct -> tradeLot, empty)

resources/bkup/imports-types.rosetta

@@ -1,4 +1,4 @@
-namespace imports.types : <"Types used for the contract dsl">
+namespace imports : <"Types used for the contract dsl">
 version "${version.ok}"
 
 import imports.enums.*

src/Model/Type.hs

@@ -135,7 +135,10 @@ data Cardinality =
   Bounds (Integer, Integer)
     -- |The cardinality starting from one bound until infinity (ex. 5 - *)
   | OneBound Integer
-  deriving Show
+
+instance Show Cardinality where
+    show (Bounds (x, y)) = "(" ++ show x ++ ".." ++ show y ++ ")"
+    show (OneBound x) = "(" ++ show x ++ ".." ++ "*)"
 
 instance Eq Cardinality where
     (==) (Bounds (x1, x2)) (Bounds (y1, y2))

src/Parser/Expression.hs

@@ -66,13 +66,13 @@ listParser =
         return $ List (expressions ++ [lastExpr])
 
 listOperations :: [String]
-listOperations = ["map", "filter", "reduce"]
+listOperations = ["map", "filter", "reduce", "contains", "disjoint"]
 
 -- |Parses a variable in Rosetta into an Expression
 variableParser :: Parser Expression
 variableParser =
     do
-        Variable <$> camelNameParser
+        Variable <$> nameParser
 
 enumValueParser :: Parser Expression
 enumValueParser =
@@ -124,8 +124,9 @@ terminalParser =
              try booleanParser,
              try emptyParser,
              try decimalParser,
-             try variableParser,
+             try functionCallParser,
              try enumValueParser,
+             try variableParser,
              integerParser
             ]
 
@@ -164,7 +165,7 @@ eqParser =
 
 -- |The list of equality statements in Rosetta
 eqFunctions :: [String]
-eqFunctions = ["=", "<", "<=", ">", ">=", "<>"]
+eqFunctions = ["=", "<=", "<>", "<", ">=", ">"]
 
 -- |Parses a sum statement in Rosetta into an Expression
 sumParser :: Parser Expression
@@ -254,6 +255,14 @@ listOpParser =
                             con <-  between (lexeme $ char '[') (lexeme $ char ']') expressionParser
                             exp <- nestedPostOp lst
                             return $ reverseExpression $ Reduce (Text.unpack o) exp v1 v2 con
+                        "contains" -> do
+                            con <- expressionParser
+                            exp <- nestedPostOp lst
+                            return $ reverseExpression $ ListOp "contains" exp con
+                        "disjoint" -> do
+                            con <- expressionParser
+                            exp <- nestedPostOp lst
+                            return $ reverseExpression $ ListOp "disjoint" exp con
                         _ -> do 
                             con <- between (lexeme $ char '[') (lexeme $ char ']') expressionParser 
                             exp <- nestedPostOp lst
@@ -286,6 +295,14 @@ nestedListOp ex =
                         con <-  between (lexeme $ char '[') (lexeme $ char ']') expressionParser
                         exp <- nestedPostOp ex
                         return $ reverseExpression $ Reduce (Text.unpack o) exp v1 v2 con
+                    "contains" -> do
+                        con <- expressionParser
+                        exp <- nestedPostOp ex
+                        return $ reverseExpression $ ListOp "contains" exp con
+                    "disjoint" -> do
+                        con <- expressionParser
+                        exp <- nestedPostOp ex
+                        return $ reverseExpression $ ListOp "disjoint" exp con
                     _ -> do
                         con <- between (lexeme $ char '[') (lexeme $ char ']') expressionParser 
                         exp <- nestedPostOp ex

src/Parser/Function.hs

@@ -38,9 +38,10 @@ aliasParser =
 assignmentParser :: Parser (Expression, Expression)
 assignmentParser =
     do
-        _ <- lexeme $ string "assign-output"
+        _ <- lexeme $ string "assign-output" <|> string "set" <|> string "add"
         out <- expressionParser
         _ <- lexeme $ char ':'
+        _ <- lexeme $ optional descriptionParser
         assignment <- expressionParser
         return (out, assignment)
 

src/Parser/Type.hs

@@ -6,13 +6,13 @@ import Model.Type
 import Text.Megaparsec.Char
 import Text.Megaparsec
 import Data.Maybe
-import Parser.General 
+import Parser.General
 import Parser.Expression (expressionParser)
-  
+
 -- |Parses a type declaration statement in Rosetta into an Type
 typeParser :: Parser Type
-typeParser = 
+typeParser =
-    do 
+    do
         tName <- try typeNameParser
         tSuper <- superTypeParser
         _ <- lexeme $ char ':'
@@ -33,29 +33,38 @@ superTypeParser =
 
 -- |Parses a declared type attribute in Rosetta into a TypeAttribute
 typeAttributeParser :: Parser TypeAttribute
-typeAttributeParser = 
+typeAttributeParser =
     do
+        _ <- many $ lexeme metaParser
         aName <- try camelNameParser
         aType <- try nameParser
         card <- cardinalityParser
         desc <- optional descriptionParser
+        _ <- many $ lexeme metaParser
         return (MakeTypeAttribute aName (MakeType aType (BasicType "Object") Nothing [] []) card desc)
 
+metaParser :: Parser String
+metaParser =
+    do
+        _ <- lexeme $ char '['
+        manyTill (letterChar <|> char ' ') (char ']')
+
 -- |Parses the cardinality of a type attribute in Rosetta into a Cardinality
 cardinalityParser :: Parser Cardinality
 cardinalityParser = try parseBounded <|> try parseSemiBounded
 
 -- |Parser the condition of a type attribute in Rosetta into a Condition
-conditionParser :: Parser Condition 
+conditionParser :: Parser Condition
 conditionParser = do
     _ <- lexeme $ string "condition"
-    description <- optional descriptionParser 
+    _ <- optional $ lexeme pascalNameParser
     _ <- lexeme $ char ':'
+    description <- optional descriptionParser
     MakeCondition description <$> expressionParser
 
 -- |Parses a bounded cardinality statement in Rosetta into a Cardinality
 parseBounded :: Parser Cardinality
-parseBounded = 
+parseBounded =
     do
         _ <- lexeme $ char '('
         low <- lexeme $ many digitChar
@@ -66,7 +75,7 @@ parseBounded =
 
 -- |Parses a one bounded cardinality statement in Rosetta into a Cardinality
 parseSemiBounded :: Parser Cardinality
-parseSemiBounded = 
+parseSemiBounded =
     do
         _ <- lexeme $ char '('
         low <- lexeme $ many digitChar
@@ -75,7 +84,7 @@ parseSemiBounded =
 
 -- |Parses the name of a type in Rosetta into a String
 typeNameParser :: Parser String
-typeNameParser = 
+typeNameParser =
     do
         _ <- lexeme $ string "type"
         pascalNameParser

src/PrettyPrinter/Header.hs

@@ -9,17 +9,17 @@ import Data.Char
 import Utils.Utils
 
 -- |Converts a Header into a haskell valid String
-printHeader :: Header -> String
+printHeader :: FilePath -> Header -> String
-printHeader (MakeHeader name (Just description) _ imports) =
+printHeader path (MakeHeader name (Just description) _ imports) =
-    show $ vcat ["module" <+> pretty (removePeriods name) <+> "where",
+    show $ vcat ["module" <+> pretty (removeChar path '-') <+> "where",
         enclose "{-" "-}" (pretty description), 
         emptyDoc,
         "import" <+> "Data.List",
         "import" <+> "Data.Maybe",
         vcat (map printImport imports),
         emptyDoc]
-printHeader (MakeHeader name Nothing _ imports) =
+printHeader path (MakeHeader name Nothing _ imports) =
-    show $ vcat ["module" <+> pretty (removePeriods name) <+> "where",
+    show $ vcat ["module" <+> pretty (removeChar path '-')  <+> "where",
         emptyDoc,
         "import" <+> "Data.List",
         "import" <+> "Data.Maybe",
@@ -28,4 +28,4 @@ printHeader (MakeHeader name Nothing _ imports) =
 
 -- |Converts an import name into an import prettyprinter doc
 printImport :: String -> Doc a
-printImport name = "import" <+> pretty (removePeriods name)
+printImport name = "import" <+> pretty (removeChar name '.')

src/Semantic/ExpressionChecker.hs

@@ -9,15 +9,19 @@ import Utils.Utils
 
 -- |A declared variable or function
 data Symbol = Var{
-   varName :: String,
+   symbolName :: String,
    declaredType :: Type,
    cardinality :: Cardinality
    }
    | Func {
-   funcName :: String,
+   symbolName :: String,
    argsType :: [(Type, Cardinality)],
    returnType :: (Type, Cardinality)
-   } deriving (Show)
+   }
+
+instance Show Symbol where
+    show (Var n t c) = "Variable {name: " ++ show n ++ ", type: " ++  show t ++ ", card: " ++ show c ++ "}"
+    show (Func n i o) = "Function {name: " ++ show n ++ ", arguments: " ++  show [((typeName . fst) t, (snd t)) | t <- i]  ++ ", return: (" ++ typeName (fst o) ++ ", " ++ show (snd o) ++ ")}"
 
 instance Eq Symbol where
     (==) (Var name1 _ _) (Var name2 _ _)
@@ -96,7 +100,7 @@ addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature
     case head $ checkAttributes definedTypes [out] of
         Left err -> Left [err]
         Right checkedOutput -> if null (lefts checkedInputs)
-            then if name `elem` map funcName definedSymbols
+            then if name `elem` map symbolName definedSymbols
                 then Left [MultipleDeclarations name]
                 else Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType checkedOutput, Model.Type.cardinality out) : definedSymbols
             else Left $ lefts checkedInputs
@@ -261,10 +265,10 @@ checkList1 defT symbs (ex : exps) typ =
 
 -- |Checks whether the function that is called is already defined with the same argument types
 checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError ExplicitExpression ] -> Either TypeCheckError ExplicitExpression
-checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: " ++ fun ++ " [" 
+checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: " ++ fun ++ " [" ++ show args ++ "]"
     ++ show [(typeName $ typeFromExpression x, toCardinality $ cardinalityCoercion $ returnCoercion x) | x <- rights args] ++ "]"
 checkFunctionCall ((Func n a r):symbolMap) name args
-    | not $ null $ lefts args = Left $ ErrorInsideFunction (name ++ ": " ++ show (lefts args))
+    | not $ null $ lefts args = error $ show symbolMap ++ "\n" ++ show (lefts args)--Left $ ErrorInsideFunction (name ++ ": " ++ show (lefts args))
     | name == n = if all isRight coerce then Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
         else checkFunctionCall symbolMap name args
     | otherwise = checkFunctionCall symbolMap name args
@@ -411,4 +415,4 @@ cardinalityIncluded (OneBound x) (Bounds (x2, y2)) = Left $ CardinalityMismatch
 cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
     | x1 == y1 && x2 == y2 = Right $ MakeCardinalityIdCoercion (Bounds (x1, x2))
     | x1 >= y1 && x2 <= y2 = Right $ MakeListCardinalityCoercion (Bounds (x1, x2)) (Bounds (y1, y2))
-    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))
+    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))

src/Utils/Utils.hs

@@ -16,42 +16,27 @@ uncapitalize s = toLower (head s) : tail s
 -- |Convert a namespace to a filename
 namespaceToName :: String -> String 
 namespaceToName [] = ".rosetta"
-namespaceToName ".*" = ".rosetta"
+namespaceToName ".*" = ".*"
 namespaceToName (c : cs)
     | c == '.' = '-' : namespaceToName cs
     | otherwise = c : namespaceToName cs
 
--- |Returns the directory of a file from a path
-fileDirectory :: String -> String
-fileDirectory s = take (length s - length (fileName s)) s
-
--- |Returns the name of a file from a path
-fileName :: String -> String
-fileName path = reverse $ fileName1 $ reverse path
-
--- |Auxiliary function for the name of a file from a path
-fileName1 :: String -> String
-fileName1 [] = []
-fileName1 (c : cs)
-    | c == '/' = []
-    | otherwise = c : fileName1 cs
-
 -- |Create a new haskell filename based on the namespace
 haskellFileName :: String -> String
-haskellFileName s = "resources/Generated/" ++ removePeriods s ++".hs"
+haskellFileName s = "resources/Generated/" ++ removeChar s '-' ++".hs"
 
 -- |Function to remove all the periods from a name, and convert the name to CamelCase
-removePeriods :: String -> String
+removeChar :: String -> Char -> String
-removePeriods [] = []
+removeChar [] _ = []
-removePeriods ['*'] = []
+removeChar ['*'] _ = []
-removePeriods (c:cs) = toUpper c : removePeriods1 cs
+removeChar (c:cs) ch = toUpper c : removeChar1 cs ch
 
 -- |Auxiliary function for converting names
-removePeriods1 :: String -> String
+removeChar1 :: String -> Char -> String
-removePeriods1 [] = []
+removeChar1 [] ch = []
-removePeriods1 (c:cs) 
+removeChar1 (c:cs) ch 
-    | c == '.' = removePeriods cs
+    | c == ch = removeChar cs ch
-    | otherwise = c : removePeriods1 cs
+    | otherwise = c : removeChar1 cs ch
 
 -- |Extract the first elements from a list of tuples
 fstlst :: [(a, b)] -> [a]
@@ -101,4 +86,10 @@ trd3 (_, _, x) = x
 replacePrefix :: Eq a => [a] -> [a] -> [a] -> [a]
 replacePrefix a b c = case stripPrefix a b of
     Nothing -> b
-    Just bs -> c ++ bs
+    Just bs -> c ++ bs
+
+-- |Get the namespace name from the import
+getNamespace :: String -> String
+getNamespace [] = []
+getNamespace ".*" = []
+getNamespace (s : ss) = s : getNamespace ss