diff --git a/.gitignore b/.gitignore index 4c9e245..174c40b 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,5 @@ cabal.project.local cabal.project.local~ .HTF/ .ghc.environment.* +.idea/ +/test/ diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..872b234 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for RosettaParser + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7caa388 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2021 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..015b81d --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# RosettaParser diff --git a/RosettaParser.cabal b/RosettaParser.cabal new file mode 100644 index 0000000..52ed882 --- /dev/null +++ b/RosettaParser.cabal @@ -0,0 +1,88 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: RosettaParser +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/RosettaParser#readme +bug-reports: https://github.com/githubuser/RosettaParser/issues +author: Author name here +maintainer: example@example.com +copyright: 2021 Author name here +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/githubuser/RosettaParser + +library + exposed-modules: + Model.Enum + Model.Function + Model.Type + Parser.AnotherExpression + Parser.Enum + Parser.Expr + Parser.Expression + Parser.Function + Parser.General + Parser.Type + PrettyPrinter.Enum + PrettyPrinter.Function + PrettyPrinter.General + PrettyPrinter.Type + other-modules: + Paths_RosettaParser + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , megaparsec + , parser-combinators + , prettyprinter + , text + , time + default-language: Haskell2010 + +executable RosettaParser-exe + main-is: Main.hs + other-modules: + Paths_RosettaParser + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + RosettaParser + , base >=4.7 && <5 + , megaparsec + , parser-combinators + , prettyprinter + , text + , time + default-language: Haskell2010 + +test-suite RosettaParser-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_RosettaParser + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + RosettaParser + , base >=4.7 && <5 + , megaparsec + , parser-combinators + , prettyprinter + , text + , time + default-language: Haskell2010 diff --git a/RosettaParser.iml b/RosettaParser.iml new file mode 100644 index 0000000..48a75b6 --- /dev/null +++ b/RosettaParser.iml @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..26ed7bf --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,54 @@ +module Main where + +import Parser.Enum +import Parser.Type +import Parser.Function +import Data.Text +import Text.Megaparsec +import PrettyPrinter.Enum +import PrettyPrinter.Type +import PrettyPrinter.Function +import Parser.Expression +import Model.Function + +main :: IO () +main = do + rosettaString <- readFile "app/testFile.rosetta" + putStrLn "rosetta String: " + putStrLn rosettaString + putStrLn "\nFinal enum: \n" + case parse enumParser "" (pack rosettaString) of + Left errorBundle -> print (errorBundlePretty errorBundle) + Right enum -> putStrLn $ printEnum enum + +testEnum :: IO() +testEnum = do + rosettaString <- readFile "src/TestFiles/testEnum.rosetta" + case parse enumParser "" (pack rosettaString) of + Left errorBundle -> print (errorBundlePretty errorBundle) + Right enum -> + do + putStrLn $ printEnum enum + writeFile "src/TestFiles/typeEnum.hs" (printEnum enum) + +testType :: IO() +testType = do + rosettaString <- readFile "src/TestFiles/testType.rosetta" + case parse typeParser "" (pack rosettaString) of + Left errorBundle -> print (errorBundlePretty errorBundle) + Right typ -> + do + putStrLn $ printType typ + print typ + writeFile "src/TestFiles/typeTest.hs" (printType typ) + +testFunc :: IO() +testFunc = do + rosettaString <- readFile "src/TestFiles/testFunction.rosetta" + case parse functionParser "" (pack rosettaString) of + Left errorBundle -> print (errorBundlePretty errorBundle) + Right fun -> + do + print $ printFunctionSignature fun + print (assignments fun) + writeFile "src/TestFiles/functionTest.hs" (show $ printFunctionSignature fun) \ No newline at end of file diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..bf40823 --- /dev/null +++ b/package.yaml @@ -0,0 +1,53 @@ +name: RosettaParser +version: 0.1.0.0 +github: "githubuser/RosettaParser" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2021 Author name here" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- megaparsec +- time +- prettyprinter +- parser-combinators +- text + +library: + source-dirs: src + +executables: + RosettaParser-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - RosettaParser + +tests: + RosettaParser-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - RosettaParser diff --git a/src/Model/Enum.hs b/src/Model/Enum.hs new file mode 100644 index 0000000..8171d83 --- /dev/null +++ b/src/Model/Enum.hs @@ -0,0 +1,13 @@ +module Model.Enum where + +data EnumType = MakeEnum { + enumName :: String, + enumDescription :: Maybe String, + enumValues :: [EnumValue] +} deriving (Show) + +data EnumValue = MakeEnumValue { + enumValueName :: String, + enumValueDescription :: Maybe String, + enumValueDisplayName :: Maybe String +} deriving (Show) \ No newline at end of file diff --git a/src/Model/Function.hs b/src/Model/Function.hs new file mode 100644 index 0000000..04cc9a1 --- /dev/null +++ b/src/Model/Function.hs @@ -0,0 +1,60 @@ +module Model.Function where + +import Model.Type (TypeAttribute) + +data Function = + MakeFunction { + functionName :: String, + functionDescription :: Maybe String, + inputParameters :: [TypeAttribute], + outputParameter :: TypeAttribute, + assignments :: [(Expression, Expression)] + } + deriving (Show) + +data Condition = + MakeCondition { + conditionDescription :: Maybe String, + conditionStatement :: Expression +-- conditionStatement :: String + } + | MakePostCondition { + conditionDescription :: Maybe String, + conditionStatement :: Expression +-- conditionStatement :: String + } + deriving (Show) + +data Expression = --String deriving (Show) + Variable String + | Literal String + | ExpressionList [Expression] + | InnerType Expression Expression + + | Or Expression Expression + | And Expression Expression + | Not Expression + + | Exists Expression + | IsAbsent Expression + | Contains Expression Expression + | Disjoint Expression Expression + | Count Expression + | OnlyExists Expression + | OnlyElement Expression + + | Equals Expression Expression + | Different Expression Expression + | GreaterStrict Expression Expression + | SmallerStrict Expression Expression + | GreaterOrEqual Expression Expression + | SmallerOrEqual Expression Expression + + | Sum Expression Expression + | Subtract Expression Expression + | Product Expression Expression + | Division Expression Expression + + | IfSimple Expression Expression + | IfElse Expression Expression Expression + deriving (Show) \ No newline at end of file diff --git a/src/Model/Type.hs b/src/Model/Type.hs new file mode 100644 index 0000000..29bbb1f --- /dev/null +++ b/src/Model/Type.hs @@ -0,0 +1,35 @@ +module Model.Type where + +import Data.Time.LocalTime() +import Model.Enum + +data BasicType = String + | Integer + | Double + | Boolean + | TimeOfDay + deriving (Show) + +data Type = + TypeFromBasicType BasicType + | TypeFromEnum EnumType + | MakeType { + typeName :: String, + typeDescription :: Maybe String, + typeAttributes :: [TypeAttribute] + } + deriving (Show) + +data TypeAttribute = MakeTypeAttribute { + attributeName :: String, + attributeType :: String, + cardinality :: Cardinality, + attributeDescription :: Maybe String +} deriving (Show) + +data Cardinality = + ZeroOrOne + | ExactlyOne + | OneOrMore -- One or more + | ZeroOrMore -- Zero or more + deriving (Show) \ No newline at end of file diff --git a/src/Parser/AnotherExpression.hs b/src/Parser/AnotherExpression.hs new file mode 100644 index 0000000..42d0325 --- /dev/null +++ b/src/Parser/AnotherExpression.hs @@ -0,0 +1,251 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.AnotherExpression where + +import Parser.General +import qualified Data.Text as Text +import Text.Megaparsec +import Text.Megaparsec.Char + +data Expression = Variable String + | Int String + | Real String + | Boolean String + | Empty + | Parens Expression + | List [Expression] + | Function String [Expression] + | PrefixExp String Expression + | PostfixExp String Expression + | InfixExp String Expression Expression + | IfSimple Expression Expression + | IfElse Expression Expression Expression + deriving (Show) + + +expressionParser :: Parser Expression +expressionParser = + choice [ ifParser, + try functionParser, + eqParser] + +-------------------------------------------- +-- Command Structures ---------------------- +-------------------------------------------- + +functionParser :: Parser Expression +functionParser = + do + f <- pascalNameParser + _ <- spaceConsumer + _ <- char '(' + ats <- many $ try (expressionParser >>= \ats -> spaceConsumer >> char ',' >> spaceConsumer >> return ats) + lat <- optional expressionParser + _ <- spaceConsumer + _ <- char ')' + _ <- spaceConsumer + case lat of + Nothing -> return $ Function f [] + Just at -> return $ Function f (ats ++ [at]) + +ifParser :: Parser Expression +ifParser = + do + _ <- string "if" + _ <- spaceConsumer + condition <- between (char '(') (char ')') expressionParser <|> expressionParser + _ <- spaceConsumer + _ <- string "then" + _ <- spaceConsumer + expr <- expressionParser + _ <- spaceConsumer + els <- observing $ string "else" + _ <- spaceConsumer + case els of + Left _ -> return (IfSimple condition expr) + Right _ -> expressionParser >>= \expr2 -> return (IfElse condition expr expr2) + +parens :: Parser a -> Parser a +parens = between (char '(') (char ')') + +-------------------------------------------- +-- Terminals ------------------------------- +-------------------------------------------- + +listParser :: Parser Expression +listParser = + do + _ <- char '[' + _ <- spaceConsumer + expressions <- many $ try (expressionParser >>= \ex -> spaceConsumer >> char ',' >> spaceConsumer >> return ex) + _ <- spaceConsumer + lastExpr <- try expressionParser + _ <- spaceConsumer + _ <- char ']' + _ <- spaceConsumer + return $ List (expressions ++ [lastExpr]) + +variableParser :: Parser Expression +variableParser = + do + var <- camelNameParser + _ <- spaceConsumer + inner <- many innerVariableParser + return $ Variable (var ++ concatMap ("->" ++) inner) + +innerVariableParser :: Parser String +innerVariableParser = + do + _ <- string "->" + _ <- spaceConsumer + var <- camelNameParser + _ <- spaceConsumer + return var + +integerParser :: Parser Expression +integerParser = + do + nr <- some digitChar + _ <- spaceConsumer + return $ Int $ show nr + +decimalParser :: Parser Expression +decimalParser = + do + nr <- some digitChar + _ <- char '.' + real <- many digitChar + _ <- spaceConsumer + return $ Real $ show nr ++ "." ++ real + +booleanParser :: Parser Expression +booleanParser = + do + bol <- string "True" <|> string "False" + _ <- spaceConsumer + return $ Boolean $ Text.unpack bol + +emptyParser :: Parser Expression +emptyParser = + do + _ <- string "empty" + _ <- spaceConsumer + return Empty + +terminalParser :: Parser Expression +terminalParser = + do + choice + [ prefixParser, + parens expressionParser >>= \e -> return (Parens e), + listParser, + try booleanParser, + try emptyParser, + try decimalParser, + try variableParser, + integerParser + ] + +-------------------------------------------- +-- Expressions ----------------------------- +-------------------------------------------- + +prefixParser :: Parser Expression +prefixParser = + do + op <- choice $ fmap (try . string . Text.pack) prefixOperators + _ <- spaceConsumer + ex <- expressionParser + _ <- spaceConsumer + return $ PrefixExp (Text.unpack op) ex + +eqParser :: Parser Expression +eqParser = + do + s <- sumParser + _ <- spaceConsumer + op <- observing (string "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=") + _ <- spaceConsumer + case op of + Left _ -> return s + Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex + +sumParser :: Parser Expression +sumParser = + do + f <- factorParser + _ <- spaceConsumer + op <- observing (char '+' <|> char '-') + _ <- spaceConsumer + case op of + Left _ -> return f + Right o -> sumParser >>= \ex -> return $ reverseExpression $ InfixExp [o] f ex + +factorParser :: Parser Expression +factorParser = + do + p <- powerParser + _ <- spaceConsumer + op <- observing (char '*' <|> char '/') + _ <- spaceConsumer + case op of + Left _ -> return p + Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex + +powerParser :: Parser Expression +powerParser = + do + p <- postfixParser + _ <- spaceConsumer + op <- observing $ char '^' + _ <- spaceConsumer + case op of + Left _ -> return p + Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex + +postfixParser :: Parser Expression +postfixParser = + do + t <- terminalParser + _ <- spaceConsumer + op <- observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element") + _ <- spaceConsumer + case op of + Left _ -> return t + Right o -> return $ PostfixExp (Text.unpack o) t + +-------------------------------------------- +-- Auxiliary ------------------------------ +-------------------------------------------- + +reverseExpression :: Expression -> Expression +reverseExpression (InfixExp op t1 (InfixExp op2 t2 e)) + | precedence op == precedence op2 = InfixExp op2 (reverseExpression (InfixExp op t1 t2)) e + | otherwise = InfixExp op t1 (InfixExp op2 t2 e) +reverseExpression e = e + +precedence :: String -> Int +precedence "or" = 1 +precedence "and" = 1 +precedence "+" = 2 +precedence "-" = 2 +precedence "*" = 3 +precedence "/" = 3 +precedence "^" = 4 +precedence _ = 100 + +prefixOperators :: [String] +prefixOperators = ["-", "not"] + +testArith3 = parseTest expressionParser "1 + (2 - 3)" +testArith4 = parseTest expressionParser "a * b - c * d - e * f = g * h - i * j - k * l" +testArith5 = parseTest expressionParser "a + b - c * d ^ e" +testArith6 = parseTest expressionParser "1 - 2 - 3 - 4 - 5 - 6" +testList = parseTest expressionParser "[1, 2, 3]" +testList2 = parseTest expressionParser "[1, 2 + 3, e]" +testFun = parseTest functionParser "Function()" +testFun2 = parseTest functionParser "Function(e)" +testFun3 = parseTest functionParser "Function(3, 3+2,e)" +testIf = parseTest expressionParser "if (Function(2 + 3, e)) then a + b - c * d ^ e -> x else not a exists" +testEverything = parseTest expressionParser "if [1, Function(3)] then 1 - 2 - 3 * a -> b ^ c" +testFail = parseTest expressionParser "if[1,as]thenxandoelseaora" \ No newline at end of file diff --git a/src/Parser/Enum.hs b/src/Parser/Enum.hs new file mode 100755 index 0000000..db53d26 --- /dev/null +++ b/src/Parser/Enum.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.Enum where + +import Parser.General +import Text.Megaparsec.Char +import Text.Megaparsec +import Model.Enum + +--parseTest enumParser "enum periodEnum: <\"description\"> D displayName \"day\" <\"Day\">" +enumParser :: Parser EnumType +enumParser = + do + eName <- enumNameParser + eDescription <- descriptionParser + values <- many enumValueParser + _ <- spaceConsumer + return (MakeEnum eName (Just eDescription) values) + +--parseTest enumValueParser "D displayName \"day\" <\"Day\">" +enumValueParser :: Parser EnumValue +enumValueParser = + do + vName <- enumValueNameParser + dName <- enumValueDisplayNameParser + vDescription <- descriptionParser + return (MakeEnumValue vName (Just vDescription) (Just dName)) + +enumValueNameParser :: Parser String +enumValueNameParser = + do + name <- nameParser + _ <- spaceConsumer + return name + +enumValueDisplayNameParser :: Parser String +enumValueDisplayNameParser = + do + _ <- string "displayName \"" + name <- anySingle `manyTill` char '"' + _ <- spaceConsumer + return name + +enumNameParser :: Parser String +enumNameParser = + do + _ <- string "enum" + _ <- spaceConsumer + name <- nameParser + _ <- char ':' + _ <- spaceConsumer + return name + +periodEnum :: EnumType +periodEnum = MakeEnum + "PeriodEnum" + (Just "The enumerated values to specifie the period, e.g. day, week.") + [MakeEnumValue + "D" + (Just "Day") + Nothing, + + MakeEnumValue + "W" + (Just "Week") + Nothing, + + MakeEnumValue + "Y" + (Just "Year") + Nothing + ] \ No newline at end of file diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs new file mode 100644 index 0000000..709a4b4 --- /dev/null +++ b/src/Parser/Expr.hs @@ -0,0 +1,3 @@ +module Parser.Expr where + +import Parser.General diff --git a/src/Parser/Expression.hs b/src/Parser/Expression.hs new file mode 100644 index 0000000..ef44f0b --- /dev/null +++ b/src/Parser/Expression.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.Expression where + +import Text.Megaparsec +import Text.Megaparsec.Char +import Model.Function +import Parser.General +import Data.Text + +variableParser :: Parser Expression +variableParser = + do + var <- camelNameParser + _ <- spaceConsumer + return $ Variable var + +integerParser :: Parser Expression +integerParser = + do + nr <- some digitChar + _ <- spaceConsumer + return $ Literal $ show nr + +decimalParser :: Parser Expression +decimalParser = + do + nr <- some digitChar + _ <- char '.' + real <- many digitChar + _ <- spaceConsumer + return $ Literal $ show nr ++ "." ++ real + +booleanParser :: Parser Expression +booleanParser = + do + bol <- string (pack "True") <|> string (pack "False") + _ <- spaceConsumer + return $ Literal $ unpack bol + +listParser :: Parser Expression +listParser = + do + _ <- char '[' + _ <- spaceConsumer + expressions <- many $ try expressionList + _ <- spaceConsumer + lastExpr <- try expressionParser + _ <- spaceConsumer + _ <- char ']' + _ <- spaceConsumer + return $ ExpressionList (expressions ++ [lastExpr]) + where + expressionList = + do + expr <- expressionParser + _ <- spaceConsumer + _ <- char ',' + _ <- spaceConsumer + return expr + +emptyParser :: Parser Expression +emptyParser = + do + _ <- string "empty" + _ <- spaceConsumer + return $ Literal "empty" + +literalParser :: Parser Expression +literalParser = + do + choice + [ booleanParser, + try emptyParser, + try decimalParser, + try variableParser, + integerParser + ] + +parensParser :: Parser Expression +parensParser = + do + _ <- char '(' + expr <- expressionParser + _ <- char ')' + return expr + +ifElseParser :: Parser Expression +ifElseParser = + do + (IfSimple cond expr) <- simpleIfParser + _ <- string "else" + _ <- spaceConsumer + expr2 <- expressionParser + _ <- spaceConsumer + return $ IfElse cond expr expr2 + +simpleIfParser :: Parser Expression +simpleIfParser = + do + _ <- string "if" + _ <- spaceConsumer + condition <- expressionParser + _ <- spaceConsumer + _ <- string "then" + _ <- spaceConsumer + expr <- expressionParser + _ <- spaceConsumer + return $ IfSimple condition expr + +andParser :: Parser Expression +andParser = + do + (ex1, ex2) <- try $ binaryParser "and" + return $ And ex1 ex2 + +orParser :: Parser Expression +orParser = + do + (ex1, ex2) <- try $ binaryParser "or" + return $ Or ex1 ex2 + +subParser :: Parser Expression +subParser = + do + (ex1, ex2) <- try $ binaryParser "-" + return $ Subtract ex1 ex2 + +notParser :: Parser Expression +notParser = + do + _ <- string "not" + _ <- spaceConsumer + ex <- expressionParser + _ <- spaceConsumer + return $ Not ex + +binaryParser :: String -> Parser (Expression, Expression) +binaryParser op = + do + ex1 <- literalParser + _ <- spaceConsumer + _ <- string $ pack op + _ <- spaceConsumer + ex2 <- expressionParser + _ <- spaceConsumer + return (ex1, ex2) + +expressionParser :: Parser Expression +expressionParser = choice + [parensParser, + notParser, + andParser, + orParser, + subParser, + ifElseParser, + simpleIfParser, + literalParser, + variableParser + ] + +testIfElse = parseTest expressionParser "if asd then 123 else 4" +testAnd = parseTest expressionParser "23 and 34 and 24 and a" +testOr = parseTest expressionParser "23 or 34 or 24 or a" +testMin = parseTest expressionParser "(a - b) - c" \ No newline at end of file diff --git a/src/Parser/Function backup.hs b/src/Parser/Function backup.hs new file mode 100644 index 0000000..9f30cbe --- /dev/null +++ b/src/Parser/Function backup.hs @@ -0,0 +1,185 @@ +module Parser.Function where + +import Model.Function +import Model.Type (TypeAttribute) +import Parser.Type (typeAttributeParser) +import Text.Megaparsec.Char +import Text.Megaparsec +import Parser.General +import Data.Text + +functionParser :: Parser Function +functionParser = + do + _ <- string $ pack "func" + _ <- spaceConsumer + fName <- pascalNameParser + _ <- char ':' + _ <- spaceConsumer + fDescription <- descriptionParser + fInput <- inputAttributesParser + fOutput <- outputAttributeParser + fConditions <- many (try postConditionParser <|> try conditionParser) + _ <- spaceConsumer + return (MakeFunction fName (Just fDescription) fInput fOutput fConditions) + +inputAttributesParser :: Parser [TypeAttribute] +inputAttributesParser = + do + _ <- string $ pack "inputs:" + _ <- spaceConsumer + inputs <- many $ try typeAttributeParser + _ <- spaceConsumer + return inputs + +outputAttributeParser :: Parser TypeAttribute +outputAttributeParser = + do + _ <- string $ pack "output:" + _ <- spaceConsumer + outputs <- typeAttributeParser + _ <- spaceConsumer + return outputs + +--parseTest conditionParser pack "condition: <\"Optional choice between directly passing a time or a timeType, which has to be resolved into a time based on the determination method.\"> if valuationTime exists then timeType is absent else if timeType exists then valuationTime is absent else False" + +conditionParser :: Parser Condition +conditionParser = + do + _ <- string $ pack "condition:" + _ <- spaceConsumer + description <- descriptionParser + (Expression statementString) <- lookAhead expressionParser + _ <- string $ pack statementString + rest <- getInput + _ <- setInput $ pack statementString + statement <- statementParser + _ <- setInput rest + _ <- spaceConsumer + return $ MakeCondition (Just description) statement +--parseTest postConditionParser (pack "post-condition: <\"The date and time must be properly resolved as attributes on the output.\"> observation -> date = ResolveAdjustableDate(valuationDate) and if valuationTime exists then observation -> time = TimeZoneFromBusinessCenterTime(valuationTime) else observation -> time = ResolveTimeZoneFromTimeType(timeType, determinationMethod)") + +postConditionParser :: Parser Condition +postConditionParser = + do + _ <- string $ pack "post-condition:" + _ <- spaceConsumer + description <- descriptionParser + (Expression statementString) <- lookAhead expressionParser + _ <- string $ pack statementString + rest <- getInput + _ <- setInput $ pack statementString + statement <- statementParser + _ <- setInput rest + _ <- spaceConsumer + return $ MakePostCondition (Just description) statement + +statementParser :: Parser Expression +statementParser = + do + statement <- + try ifElseParser <|> + try ifParser <|> + + try (binaryOpParser " and ") <|> + try (binaryOpParser " contains ") <|> + try (binaryOpParser " or ") <|> + try (binaryOpParser " = ") <|> + try (binaryOpParser " <> ") <|> + try (binaryOpParser " < ") <|> + try (binaryOpParser " <= ") <|> + try (binaryOpParser " >") <|> + try (binaryOpParser " >= ") <|> + + try (unaryOpParser " count") <|> + try (unaryOpParser " exists") <|> + try (unaryOpParser " is absent") <|> + + expressionParser + _ <- spaceConsumer + return statement + +--binaryOpParser :: String -> Parser Expression +--binaryOpParser op = +-- do +-- argument1String <- untilParser op +-- rest <- getInput +-- _ <- setInput $ pack argument1String +-- argument1 <- statementParser +-- _ <- setInput rest +-- _ <- spaceConsumer +-- argument2 <- statementParser +-- _ <- spaceConsumer +-- return $ BinaryOp (unpack $ strip $ pack op) argument1 argument2 +-- +--unaryOpParser :: String -> Parser Expression +--unaryOpParser op = +-- do +-- statementString <- untilParser op +-- rest <- getInput +-- _ <- setInput $ pack statementString +-- statement <- statementParser +-- _ <- setInput rest +-- _ <- spaceConsumer +-- return $ UnaryOp (unpack $ strip $ pack op) statement +-- +--ifParser :: Parser Expression +--ifParser = +-- do +-- _ <- string $ pack "if" +-- _ <- spaceConsumer +-- cond <- statementParser +-- _ <- spaceConsumer +-- _ <- string $ pack "then" +-- expr <- statementParser +-- _ <- spaceConsumer +-- return $ IfSimple cond expr + +--ifParser :: Parser Expression +--ifParser = +-- do +-- _ <- string $ pack "if" +-- _ <- spaceConsumer +-- conditionString <- untilParser "then" +-- rest <- getInput +-- _ <- setInput $ pack conditionString +-- condition <- statementParser +-- _ <- setInput rest +-- _ <- spaceConsumer +-- stmt <- statementParser +-- return $ If condition stmt + +--ifElseParser :: Parser Expression +--ifElseParser = +-- do +-- _ <- string $ pack "if" +-- _ <- spaceConsumer +-- conditionString <- untilParser "then" +-- rest <- getInput +-- _ <- setInput $ pack conditionString +-- condition <- statementParser +-- _ <- setInput rest +-- _ <- spaceConsumer +-- thenString <- untilParser "else" +-- rest1 <- getInput +-- _ <- setInput $ pack thenString +-- thenExpression <- statementParser +-- _ <- setInput rest1 +-- _ <- spaceConsumer +-- elseExpression <- statementParser +-- return $ IfElse condition thenExpression elseExpression + +--parseTest expressionParser (pack "alalala condition:") + +expressionParser :: Parser Expression +expressionParser = + do + statement <- + untilParser "post-condition:" <|> + untilParser "condition:" <|> + untilParser "func" <|> + untilParser "enum" <|> + untilParser "type" <|> + try (anySingle `manyTill` eof) + _ <- spaceConsumer + return $ Expression $ unpack (strip $ pack statement) \ No newline at end of file diff --git a/src/Parser/Function.hs b/src/Parser/Function.hs new file mode 100644 index 0000000..80c7ab0 --- /dev/null +++ b/src/Parser/Function.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.Function where + +import Parser.Expression +import Parser.Type +import Model.Function +import Model.Type +import Text.Megaparsec +import Text.Megaparsec.Char +import Parser.General + +functionParser :: Parser Function +functionParser = + do + _ <- string "func" + _ <- spaceConsumer + fName <- pascalNameParser + _ <- char ':' + _ <- spaceConsumer + fDescription <- descriptionParser + fInput <- inputAttributesParser + fOutput <- outputAttributeParser + fAssignments <- many assignmentParser + _ <- spaceConsumer + return (MakeFunction fName (Just fDescription) fInput fOutput fAssignments) + +assignmentParser :: Parser (Expression, Expression) +assignmentParser = + do + _ <- string "assign-output" + _ <- spaceConsumer + name <- expressionParser + _ <- spaceConsumer + _ <- char ':' + _ <- spaceConsumer + expr <- expressionParser + _ <- spaceConsumer + return (name, expr) + +inputAttributesParser :: Parser [TypeAttribute] +inputAttributesParser = + do + _ <- string "inputs:" + _ <- spaceConsumer + inputs <- many $ try attributeParser + _ <- spaceConsumer + return inputs + +outputAttributeParser :: Parser TypeAttribute +outputAttributeParser = + do + _ <- string "output:" + _ <- spaceConsumer + outputs <- attributeParser + _ <- spaceConsumer + return outputs + +attributeParser :: Parser TypeAttribute +attributeParser = + do + nam <- camelNameParser + _ <- spaceConsumer + typ <- pascalNameParser <|> camelNameParser + _ <- spaceConsumer + crd <- cardinalityParser + _ <- spaceConsumer + desc <- optional descriptionParser + return $ MakeTypeAttribute nam typ crd desc + \ No newline at end of file diff --git a/src/Parser/General.hs b/src/Parser/General.hs new file mode 100755 index 0000000..4f7ffeb --- /dev/null +++ b/src/Parser/General.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.General where + +import Text.Megaparsec +import Data.Void +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import Data.Text + +type Parser = Parsec Void Text + +spaceConsumer :: Parser () +spaceConsumer = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/") + +symbol :: Text -> Parser Text +symbol = L.symbol spaceConsumer + +descriptionParser :: Parser String +descriptionParser = + do + _ <- string "<\"" + description <- anySingle `manyTill` string "\">" + _ <- spaceConsumer + return description + + +pascalNameParser :: Parser String +pascalNameParser = + do + first <- upperChar + rest <- many (letterChar <|> digitChar <|> char '_') + _ <- spaceConsumer + return (first : rest) + +camelNameParser :: Parser String +camelNameParser = + do + first <- lowerChar + rest <- many (letterChar <|> digitChar <|> char '_') + _ <- spaceConsumer + return (first : rest) + +nameParser :: Parser String +nameParser = + do + first <- letterChar <|> char '_' + rest <- many (letterChar <|> digitChar <|> char '_') + _ <- spaceConsumer + return (first:rest) + +untilParser :: String -> Parser String +untilParser x = try (anySingle `manyTill` string (pack x)) \ No newline at end of file diff --git a/src/Parser/Type.hs b/src/Parser/Type.hs new file mode 100644 index 0000000..39e0a41 --- /dev/null +++ b/src/Parser/Type.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.Type where + +import Model.Type +import Text.Megaparsec.Char +import Text.Megaparsec +import Parser.General + +--parseTest typeParser "type Period: <\"description\"> periodMultiplier int (1..1) <\"A time period multiplier\"> period periodEnum (1..1) <\"A time period \">" +typeParser :: Parser Type +typeParser = + do + tName <- typeNameParser + tDescription <- descriptionParser + tAttributes <- many $ try typeAttributeParserWDesc <|> try typeAttributeParser + _ <- spaceConsumer + return (MakeType tName (Just tDescription) tAttributes) + +typeAttributeParserWDesc :: Parser TypeAttribute +typeAttributeParserWDesc = + do + (MakeTypeAttribute aName aType card Nothing) <- typeAttributeParser + descriptionParser >>= \aDescription -> return (MakeTypeAttribute aName aType card (Just aDescription)) + +typeAttributeParser :: Parser TypeAttribute +typeAttributeParser = + do + aName <- attributeNameParser + aType <- nameParser + _ <- spaceConsumer + card <- cardinalityParser + _ <- spaceConsumer + return (MakeTypeAttribute aName aType card Nothing) + +cardinalityParser :: Parser Cardinality +cardinalityParser = + do + card <- parseExactlyOne <|> parseOneOrMore <|> parseZeroOrMore <|> parseZeroOrOne + _ <- spaceConsumer + return card + +parseOneOrMore :: Parser Cardinality +parseOneOrMore = + do + _ <- string "(1..*)" + return OneOrMore + + +parseExactlyOne :: Parser Cardinality +parseExactlyOne = + do + _ <- string "(1..1)" + return ExactlyOne + + +parseZeroOrMore :: Parser Cardinality +parseZeroOrMore = + do + _ <- string "(0..*)" + return ZeroOrMore + + +parseZeroOrOne :: Parser Cardinality +parseZeroOrOne = + do + _ <- string "(0..1)" + return ZeroOrOne + +attributeNameParser :: Parser String +attributeNameParser = + do + name <- camelNameParser + _ <- spaceConsumer + return name + +enumValueDisplayNameParser :: Parser String +enumValueDisplayNameParser = + do + _ <- string "displayName \"" + name <- anySingle `manyTill` char '"' + _ <- spaceConsumer + return name + +typeNameParser :: Parser String +typeNameParser = + do + _ <- string "type" + _ <- spaceConsumer + name <- pascalNameParser + _ <- char ':' + _ <- spaceConsumer + return name + +periodType :: Type +periodType = MakeType + "Period" + (Just "A class to define recurring periods or time offsets") + [MakeTypeAttribute + "periodMultiplier" + "Integer" + ExactlyOne + (Just "A time period multiplier"), + + MakeTypeAttribute + "period" + "periodEnum" + ExactlyOne + (Just "A time period") + ] \ No newline at end of file diff --git a/src/PrettyPrinter/Enum.hs b/src/PrettyPrinter/Enum.hs new file mode 100644 index 0000000..2490000 --- /dev/null +++ b/src/PrettyPrinter/Enum.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PrettyPrinter.Enum where + +import Model.Enum +import PrettyPrinter.General +import Prettyprinter + +printEnum :: EnumType -> String +printEnum (MakeEnum name description values) = + show $ printDescription description + (vcat ["data" <+> pretty name <+> "=", + indent 4 (printEnumValues values), + "", + printDisplayNames name values]) + +printEnumValues :: [EnumValue] -> Doc a +printEnumValues [] = "" +printEnumValues (x:xs) = vcat (printFirstEnumValue x: map printEnumValue xs) + +printFirstEnumValue :: EnumValue -> Doc a +printFirstEnumValue (MakeEnumValue name description _) = + printDescription description (pretty name) + +printEnumValue :: EnumValue -> Doc a +printEnumValue (MakeEnumValue name description _) = + printDescription description ("|" <+> pretty name) + +printDisplayNames :: String -> [EnumValue] -> Doc a +printDisplayNames name values = + nest 4 $ vcat ("instance Show" <+> pretty name <+> "where": map printDisplayName values) + +printDisplayName :: EnumValue -> Doc a +printDisplayName (MakeEnumValue name _ (Just display)) = + "show" <+> pretty name <+> "= \"" <> pretty display <> "\"" +printDisplayName (MakeEnumValue name _ Nothing) = + "show" <+> pretty name <+> "= \"" <> pretty name <> "\"" + + diff --git a/src/PrettyPrinter/Function.hs b/src/PrettyPrinter/Function.hs new file mode 100644 index 0000000..ab1e2da --- /dev/null +++ b/src/PrettyPrinter/Function.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PrettyPrinter.Function where + +import Prettyprinter +import Model.Function +import PrettyPrinter.General +import PrettyPrinter.Type + +-- show printStatementTree + +printFunctionSignature :: Function -> Doc a +printFunctionSignature (MakeFunction name description inputs output _) = + printDescription description (pretty name <+> prettyPrintType (Prelude.map printCardinality (inputs ++ [output]))) + +prettyPrintType :: [Doc x] -> Doc x +prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->") \ No newline at end of file diff --git a/src/PrettyPrinter/General.hs b/src/PrettyPrinter/General.hs new file mode 100644 index 0000000..cfaf8fd --- /dev/null +++ b/src/PrettyPrinter/General.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PrettyPrinter.General where + +import Prettyprinter + +printDescription :: Maybe String -> Doc a -> Doc a +printDescription (Just description) doc = + vcat [enclose "{-" "-}" (pretty description), doc] +printDescription Nothing doc = doc \ No newline at end of file diff --git a/src/PrettyPrinter/Type.hs b/src/PrettyPrinter/Type.hs new file mode 100644 index 0000000..3208443 --- /dev/null +++ b/src/PrettyPrinter/Type.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PrettyPrinter.Type where + +import Prettyprinter +import PrettyPrinter.General +import Model.Type +import Model.Enum + +printType :: Type -> String +printType (MakeType name description attributes) = + show $ printDescription description (vcat [nest 4 $ vcat("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""]) +printType x = show x + +printTypeName :: Type -> String +printTypeName (MakeType name _ _) = name +printTypeName (TypeFromBasicType name) = show name +printTypeName (TypeFromEnum (MakeEnum name _ _)) = name + +printAttribute :: TypeAttribute -> Doc a +printAttribute (MakeTypeAttribute name typ crd description) = + printDescription description + (pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description)) + +printCardinality :: TypeAttribute -> Doc a +printCardinality (MakeTypeAttribute _ typ ExactlyOne _) = pretty typ +printCardinality (MakeTypeAttribute _ typ OneOrMore _) = "[" <> pretty typ <> "]" +printCardinality (MakeTypeAttribute _ typ ZeroOrMore _) = "[" <> pretty typ <> "]" +printCardinality (MakeTypeAttribute _ typ ZeroOrOne _) = "Maybe" <+> pretty typ \ No newline at end of file diff --git a/src/TestFiles/functionTest.hs b/src/TestFiles/functionTest.hs new file mode 100644 index 0000000..8efae20 --- /dev/null +++ b/src/TestFiles/functionTest.hs @@ -0,0 +1,7 @@ +{-Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class.-} +EquityPriceObservation :: Equity + -> AdjustableOrRelativeDate + -> Maybe BusinessCenterTime + -> Maybe TimeTypeEnum + -> [DeterminationMethodEnum] + -> ObservationPrimitive \ No newline at end of file diff --git a/src/TestFiles/testEnum.rosetta b/src/TestFiles/testEnum.rosetta new file mode 100755 index 0000000..b00a9d1 --- /dev/null +++ b/src/TestFiles/testEnum.rosetta @@ -0,0 +1,4 @@ +enum PeriodEnum: <"description"> + D displayName "day" <"Day"> + M displayName "month" <"Month"> + Y displayName "year" <"Year"> \ No newline at end of file diff --git a/src/TestFiles/testFunction.rosetta b/src/TestFiles/testFunction.rosetta new file mode 100644 index 0000000..bc20ce6 --- /dev/null +++ b/src/TestFiles/testFunction.rosetta @@ -0,0 +1,12 @@ +func EquityPriceObservation: <"Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class."> + inputs: + equity Equity (1..1) + valuationDate AdjustableOrRelativeDate (1..1) + valuationTime BusinessCenterTime (0..1) + timeType TimeTypeEnum (0..1) + determinationMethod DeterminationMethodEnum (1..*) + output: + observation ObservationPrimitive (1..1) + + assign-output + observation: if asd exists then var2 \ No newline at end of file diff --git a/src/TestFiles/testType.rosetta b/src/TestFiles/testType.rosetta new file mode 100644 index 0000000..7aa9021 --- /dev/null +++ b/src/TestFiles/testType.rosetta @@ -0,0 +1,13 @@ +type Period: <"description"> + periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."> + period periodEnum (1..1) <"A time period, e.g. a day, week, month or year of the stream. If the periodMultiplier values is 0 (zero) then period must contain the value D (day)."> + testMany testType (0..*) <"Test many"> + testSome testSomeType (1..*) <"Test some"> + testMaybeOne testZeroOneType (0..1) <"Test zero or one"> + +type Period: <"description"> + periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."> + period periodEnum (1..1) <"A time period, e.g. a day, week, month or year of the stream. If the periodMultiplier values is 0 (zero) then period must contain the value D (day)."> + testMany testType (0..*) <"Test many"> + testSome testSomeType (1..*) <"Test some"> + testMaybeOne testZeroOneType (0..1) <"Test zero or one"> \ No newline at end of file diff --git a/src/TestFiles/typeEnum.hs b/src/TestFiles/typeEnum.hs new file mode 100644 index 0000000..63d55da --- /dev/null +++ b/src/TestFiles/typeEnum.hs @@ -0,0 +1,13 @@ +{-description-} +data PeriodEnum = + {-Day-} + D + {-Month-} + | M + {-Year-} + | Y + +instance Show PeriodEnum where + show D = "day" + show M = "month" + show Y = "year" \ No newline at end of file diff --git a/src/TestFiles/typeTest.hs b/src/TestFiles/typeTest.hs new file mode 100644 index 0000000..7e6af25 --- /dev/null +++ b/src/TestFiles/typeTest.hs @@ -0,0 +1,13 @@ +{-description-} +data Period = MakePeriod { + {-A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.-} + periodMultiplier :: int + {-A time period, e.g. a day, week, month or year of the stream. If the periodMultiplier values is 0 (zero) then period must contain the value D (day).-} + period :: periodEnum + {-Test many-} + testMany :: [testType] + {-Test some-} + testSome :: [testSomeType] + {-Test zero or one-} + testMaybeOne :: Maybe testZeroOneType +} diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..b4daab0 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/10.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..ad541a8 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 587546 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/10.yaml + sha256: 88b4f81e162ba3adc230a9fcccc4d19ac116377656bab56c7382ca88598b257a + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/10.yaml