From 1fa06c7a7935c29deba328e0fb22768cd8aab0a5 Mon Sep 17 00:00:00 2001 From: _ Date: Fri, 13 Aug 2021 10:38:08 +0800 Subject: [PATCH] sql: add scalar functions (#511) --- hstream-sql/etc/SQL.cf | 11 ++ hstream-sql/hstream-sql.cabal | 4 +- hstream-sql/src/HStream/SQL/AST.hs | 14 ++- .../src/HStream/SQL/Internal/Codegen.hs | 70 ++++++++++++ hstream-sql/src/HStream/SQL/Validate/Utils.hs | 32 ++++++ .../test/HStream/SQL/Codegen/ArraySpec.hs | 104 ++++++++++++++++++ .../test/HStream/SQL/Codegen/MathSpec.hs | 29 +++++ hstream-sql/test/HStream/SQL/CodegenSpec.hs | 14 --- hstream-sql/test/HStream/SQL/ValidateSpec.hs | 51 ++++++++- 9 files changed, 310 insertions(+), 19 deletions(-) create mode 100644 hstream-sql/test/HStream/SQL/Codegen/ArraySpec.hs create mode 100644 hstream-sql/test/HStream/SQL/Codegen/MathSpec.hs delete mode 100644 hstream-sql/test/HStream/SQL/CodegenSpec.hs diff --git a/hstream-sql/etc/SQL.cf b/hstream-sql/etc/SQL.cf index 18e979215..c2c570ec8 100644 --- a/hstream-sql/etc/SQL.cf +++ b/hstream-sql/etc/SQL.cf @@ -268,6 +268,17 @@ ScalarFuncStrlen. ScalarFunc ::= "STRLEN(" ValueExpr ")" ; ScalarFuncIfNull. ScalarFunc ::= "IFNULL(" ValueExpr "," ValueExpr ")" ; ScalarFuncNullIf. ScalarFunc ::= "NULLIF(" ValueExpr "," ValueExpr ")" ; +ScalarFuncDateStr. ScalarFunc ::= "DATETOSTRING(" ValueExpr "," ValueExpr ")" ; +ScalarFuncStrDate. ScalarFunc ::= "STRINGTODATE(" ValueExpr "," ValueExpr ")" ; + +ScalarFuncSplit. ScalarFunc ::= "SPLIT(" ValueExpr "," ValueExpr ")" ; +ScalarFuncChunksOf. ScalarFunc ::= "CHUNKSOF(" ValueExpr "," ValueExpr ")" ; + +ScalarFuncTake. ScalarFunc ::= "TAKE(" ValueExpr "," ValueExpr ")" ; +ScalarFuncTakeEnd. ScalarFunc ::= "TAKEEND(" ValueExpr "," ValueExpr ")" ; +ScalarFuncDrop. ScalarFunc ::= "DROP(" ValueExpr "," ValueExpr ")" ; +ScalarFuncDropEnd. ScalarFunc ::= "DROPEND(" ValueExpr "," ValueExpr ")" ; + ArrayFuncContain. ScalarFunc ::= "ARRAY_CONTAIN(" ValueExpr "," ValueExpr ")" ; ArrayFuncDistinct. ScalarFunc ::= "ARRAY_DISTINCT(" ValueExpr ")" ; ArrayFuncExcept. ScalarFunc ::= "ARRAY_EXCEPT(" ValueExpr "," ValueExpr ")" ; diff --git a/hstream-sql/hstream-sql.cabal b/hstream-sql/hstream-sql.cabal index f10b9654a..ec8baf3fc 100644 --- a/hstream-sql/hstream-sql.cabal +++ b/hstream-sql/hstream-sql.cabal @@ -102,7 +102,8 @@ test-suite hstream-sql-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - HStream.SQL.CodegenSpec + HStream.SQL.Codegen.ArraySpec + HStream.SQL.Codegen.MathSpec HStream.SQL.ParseRefineSpec HStream.SQL.ValidateSpec hs-source-dirs: test @@ -115,6 +116,7 @@ test-suite hstream-sql-test , hstream-sql , hstream-common , hstream-processing + , HUnit , random ^>=1.2 , scientific , text diff --git a/hstream-sql/src/HStream/SQL/AST.hs b/hstream-sql/src/HStream/SQL/AST.hs index 50c8daf25..d5fad6d3e 100644 --- a/hstream-sql/src/HStream/SQL/AST.hs +++ b/hstream-sql/src/HStream/SQL/AST.hs @@ -86,8 +86,10 @@ data Constant = ConstantNull data BinaryOp = OpAdd | OpSub | OpMul | OpAnd | OpOr - | OpContain | OpExcept | OpIntersect | OpRemove | OpUnion | OpArrJoin' - | OpIfNull | OpNullIf + | OpContain | OpExcept | OpIntersect | OpRemove | OpUnion | OpArrJoin' + | OpIfNull | OpNullIf | OpDateStr | OpStrDate + | OpSplit | OpChunksOf + | OpTake | OpTakeEnd | OpDrop | OpDropEnd deriving (Eq, Show) data UnaryOp = OpSin | OpSinh | OpAsin | OpAsinh | OpCos | OpCosh @@ -141,6 +143,14 @@ instance Refine ValueExpr where -- FIXME: Inconsistent form (Position instead of (ExprScalarFunc _ (ArrayFuncRemove _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpRemove (refine e1) (refine e2) (ExprScalarFunc _ (ArrayFuncUnion _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpUnion (refine e1) (refine e2) (ExprScalarFunc _ (ArrayFuncJoinWith _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpArrJoin' (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncDateStr _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpDateStr (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncStrDate _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpStrDate (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncSplit _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpSplit (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncChunksOf _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpChunksOf (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncTake _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpTake (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncTakeEnd _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpTakeEnd (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncDrop _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpDrop (refine e1) (refine e2) + (ExprScalarFunc _ (ScalarFuncDropEnd _ e1 e2)) -> RExprBinOp (trimSpacesPrint expr) OpDropEnd (refine e1) (refine e2) (ExprInt _ n) -> RExprConst (trimSpacesPrint expr) (ConstantInt . fromInteger . refine $ n) -- WARNING: May lose presision (ExprNum _ n) -> RExprConst (trimSpacesPrint expr) (ConstantNum $ refine n) (ExprString _ s) -> RExprConst (trimSpacesPrint expr) (ConstantString s) diff --git a/hstream-sql/src/HStream/SQL/Internal/Codegen.hs b/hstream-sql/src/HStream/SQL/Internal/Codegen.hs index 175d80c4a..79b933757 100644 --- a/hstream-sql/src/HStream/SQL/Internal/Codegen.hs +++ b/hstream-sql/src/HStream/SQL/Internal/Codegen.hs @@ -29,8 +29,13 @@ import HStream.SQL.AST import HStream.SQL.Exception (SomeRuntimeException (..), SomeSQLException (..), throwSQLException) +import HStream.Utils +import qualified Prelude as Prelude import RIO import Text.StringRandom (stringRandomIO) +import qualified Z.Data.CBytes as ZCB +import qualified Z.Data.Text as ZT +import Z.IO.Time -------------------------------------------------------------------------------- getFieldByName :: HasCallStack => Object -> Text -> Value @@ -88,7 +93,46 @@ binOpOnValue OpUnion _ Null = Null binOpOnValue OpUnion (Array xs) (Array ys) = Array (nub $ xs <> ys) binOpOnValue OpArrJoin' (Array xs) (String s) = String (arrJoinPrim xs (Just s)) binOpOnValue OpIfNull Null x = x +binOpOnValue OpIfNull x _ = x binOpOnValue OpNullIf x y = if x == y then Null else x +binOpOnValue OpDateStr (Number date) (String fmt) = String $ dateToStrGMT date fmt +binOpOnValue OpStrDate (String date) (String fmt) = Number $ strToDateGMT date fmt +binOpOnValue OpSplit Null _ = Null +binOpOnValue OpSplit _ Null = Null +binOpOnValue OpSplit (String x) (String xs) = Array . V.fromList $ String <$> + (if T.length x == 1 + then T.split (== T.head x) + else T.splitOn x) xs +binOpOnValue OpChunksOf _ Null = Null +binOpOnValue OpChunksOf (Number n) (String xs) = Array . V.fromList $ String <$> + T.chunksOf (case toBoundedInteger n of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpChunksOf on chunks of size " ++ show n ++ " is not supported")) xs +binOpOnValue OpTake _ Null = Null +binOpOnValue OpTake (Number n) (String xs) = String $ + T.take (case toBoundedInteger n of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpTake on size " ++ show n ++ " is not supported")) xs +binOpOnValue OpTakeEnd _ Null = Null +binOpOnValue OpTakeEnd (Number n) (String xs) = String $ + T.takeEnd (case toBoundedInteger n of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpTakeEnd on size " ++ show n ++ " is not supported")) xs +binOpOnValue OpDrop _ Null = Null +binOpOnValue OpDrop (Number n) (String xs) = String $ + T.drop (case toBoundedInteger n of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpDrop on size " ++ show n ++ " is not supported")) xs +binOpOnValue OpDropEnd _ Null = Null +binOpOnValue OpDropEnd (Number n) (String xs) = String $ + T.dropEnd (case toBoundedInteger n of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpDropEnd on size " ++ show n ++ " is not supported")) xs binOpOnValue op v1 v2 = throwSQLException CodegenException Nothing ("Operation " <> show op <> " on " <> show v1 <> " and " <> show v2 <> " is not supported") @@ -230,3 +274,29 @@ arrJoinPrim xs delimiterM | null xs = T.empty ifNull :: Value -> Value -> Value ifNull Null = id ifNull x = const x + +strToDateGMT :: T.Text -> T.Text -> Scientific +strToDateGMT date fmt = parseSystemTimeGMT (case timeFmt fmt of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpStrDate on time format " <> show fmt <> " is not supported")) (textToCBytes date) + & systemSeconds & Prelude.toInteger & flip scientific 0 + +dateToStrGMT :: Scientific -> T.Text -> T.Text +dateToStrGMT date fmt = + let sysTime = MkSystemTime (case toBoundedInteger date of + Just x -> x + _ -> throwSQLException CodegenException Nothing "Impossible happened...") 0 + in formatSystemTimeGMT (case timeFmt fmt of + Just x -> x + _ -> throwSQLException CodegenException Nothing + ("Operation OpDateStr on time format " <> show fmt <> " is not supported")) sysTime + & cBytesToText + +timeFmt :: T.Text -> Maybe ZCB.CBytes +timeFmt fmt + | textToCBytes fmt == simpleDateFormat = Just simpleDateFormat + | textToCBytes fmt == iso8061DateFormat = Just iso8061DateFormat + | textToCBytes fmt == webDateFormat = Just webDateFormat + | textToCBytes fmt == mailDateFormat = Just mailDateFormat + | otherwise = Nothing diff --git a/hstream-sql/src/HStream/SQL/Validate/Utils.hs b/hstream-sql/src/HStream/SQL/Validate/Utils.hs index 5ac5a881e..1bea5d38e 100644 --- a/hstream-sql/src/HStream/SQL/Validate/Utils.hs +++ b/hstream-sql/src/HStream/SQL/Validate/Utils.hs @@ -72,6 +72,14 @@ instance HaveValueExpr ScalarFunc where (ArrayFuncMax _ e) -> e (ArrayFuncMin _ e) -> e (ArrayFuncSort _ e) -> e + (ScalarFuncDateStr _ e _) -> e + (ScalarFuncStrDate _ e _) -> e + (ScalarFuncSplit _ e _) -> e + (ScalarFuncChunksOf _ e _) -> e + (ScalarFuncTake _ e _) -> e + (ScalarFuncTakeEnd _ e _) -> e + (ScalarFuncDrop _ e _) -> e + (ScalarFuncDropEnd _ e _) -> e class HavePos a where getPos :: a -> BNFC'Position @@ -131,6 +139,14 @@ instance HavePos ScalarFunc where (ArrayFuncMax pos _) -> pos (ArrayFuncMin pos _) -> pos (ArrayFuncSort pos _) -> pos + (ScalarFuncDateStr pos _ _) -> pos + (ScalarFuncStrDate pos _ _) -> pos + (ScalarFuncSplit pos _ _) -> pos + (ScalarFuncChunksOf pos _ _) -> pos + (ScalarFuncTake pos _ _) -> pos + (ScalarFuncTakeEnd pos _ _) -> pos + (ScalarFuncDrop pos _ _) -> pos + (ScalarFuncDropEnd pos _ _) -> pos instance HavePos SearchCond where getPos cond = case cond of @@ -214,6 +230,14 @@ getScalarFuncType f = case f of (ArrayFuncMax _ _) -> 0b0100_0000 (ArrayFuncMin _ _) -> 0b0100_0000 (ArrayFuncSort _ _) -> 0b0100_0000 + (ScalarFuncDateStr _ _ _) -> 0b0010_0000 + (ScalarFuncStrDate _ _ _) -> 0b0000_0100 + (ScalarFuncSplit _ _ _) -> 0b0100_0000 + (ScalarFuncChunksOf _ _ _) -> 0b0100_0000 + (ScalarFuncTake _ _ _) -> 0b0010_0000 + (ScalarFuncTakeEnd _ _ _) -> 0b0010_0000 + (ScalarFuncDrop _ _ _) -> 0b0010_0000 + (ScalarFuncDropEnd _ _ _) -> 0b0010_0000 getScalarArgType :: ScalarFunc -> Word8 getScalarArgType f = case f of @@ -270,6 +294,14 @@ getScalarArgType f = case f of (ArrayFuncMax _ _) -> anyMask (ArrayFuncMin _ _) -> anyMask (ArrayFuncSort _ _) -> anyMask + (ScalarFuncDateStr _ _ _) -> numMask + (ScalarFuncStrDate _ _ _) -> stringMask + (ScalarFuncSplit _ _ _) -> stringMask + (ScalarFuncChunksOf _ _ _) -> stringMask + (ScalarFuncTake _ _ _) -> anyMask + (ScalarFuncTakeEnd _ _ _) -> anyMask + (ScalarFuncDrop _ _ _) -> anyMask + (ScalarFuncDropEnd _ _ _) -> anyMask isTypeInt, isTypeFloat, isTypeNum, isTypeOrd, isTypeBool, isTypeString :: Word8 -> Bool isTypeInt n = n .&. intMask /= 0 diff --git a/hstream-sql/test/HStream/SQL/Codegen/ArraySpec.hs b/hstream-sql/test/HStream/SQL/Codegen/ArraySpec.hs new file mode 100644 index 000000000..dc6224a05 --- /dev/null +++ b/hstream-sql/test/HStream/SQL/Codegen/ArraySpec.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HStream.SQL.Codegen.ArraySpec where + +import qualified Data.Aeson as A +import Data.Function +import HStream.SQL.AST +import HStream.SQL.Internal.Codegen +import Test.Hspec + +spec :: Spec +spec = describe "Array Scalar Functions" do + + it "ARRAY_DISTINCT__0" do + unaryOpOnValue OpDistinct (A.Number <$> [1, 1, 2, 3, 1, 2] & A.Array) + `shouldBe` (A.Number <$> [1, 2, 3] & A.Array) + + it "ARRAY_DISTINCT__1" do + unaryOpOnValue OpDistinct ([A.String "apple", A.String "apple", A.Null, A.String "cherry"] & A.Array) + `shouldBe` ([A.String "apple", A.Null, A.String "cherry"] & A.Array) + + it "ARRAY_EXCEPT__0" do + binOpOnValue OpExcept (A.Number <$> [1, 2, 3, 1, 2] & A.Array) (A.Number <$> [2, 3] & A.Array) + `shouldBe` A.Array [A.Number 1] + + it "ARRAY_EXCEPT__1" do + binOpOnValue OpExcept (A.Array [A.String "apple", A.String "apple", A.Null, A.String "cherry"]) + (A.Array [A.String "cherry"]) `shouldBe` A.Array [A.String "apple", A.Null] + + it "ARRAY_INTERSECT__0" do + (binOpOnValue OpIntersect `on` (\x -> A.Number <$> x & A.Array)) [1, 2, 3, 1, 2] [2, 1] + `shouldBe` (A.Number <$> [1, 2] & A.Array) + + it "ARRAY_INTERSECT__1" do + binOpOnValue OpIntersect (A.Array [A.String "apple", A.String "apple", A.Null, A.String "cherry"]) + (A.Array [A.String "apple"]) `shouldBe` A.Array [A.String "apple"] + +--- derived decEq + it "ARRAY_MAX__0" do + unaryOpOnValue OpArrMax (A.Array [A.Number (-1), A.Number 2, A.Null, A.Number 0]) + `shouldBe` A.Null + + it "ARRAY_MAX__1" do + unaryOpOnValue OpArrMax (A.Array [A.Bool True, A.Bool False]) + `shouldBe` A.Bool True + + it "ARRAY_MAX__2" do + unaryOpOnValue OpArrMax (A.Array [A.Number 23, A.Number 24, A.String "r"]) + `shouldBe` A.Number 24 + + it "ARRAY_MAX__3" do + unaryOpOnValue OpArrMax (A.Array [A.String "Foo", A.String "Bar", A.String "baz"]) + `shouldBe` A.String "baz" + + it "ARRAY_MIN__0" do + unaryOpOnValue OpArrMin (A.Array [A.Number (-1), A.Number 2, A.Null, A.Number 0]) + `shouldBe` A.Number (-1) + + it "ARRAY_MIN__1" do + unaryOpOnValue OpArrMin (A.Array [A.Bool True, A.Bool False]) + `shouldBe` A.Bool False + + it "ARRAY_MIN__2" do + unaryOpOnValue OpArrMin (A.Array [A.Number 23, A.Number 24, A.String "r"]) + `shouldBe` A.String "r" + + it "ARRAY_MIN__3" do + unaryOpOnValue OpArrMin (A.Array [A.String "Foo", A.String "Bar", A.String "baz"]) + `shouldBe` A.String "Bar" + + it "ARRAY_REMOVE__0" do + binOpOnValue OpRemove (A.Number <$> [1, 2, 3, 2, 1] & A.Array) (A.Number 2) + `shouldBe` (A.Number <$> [1, 3, 1] & A.Array) + + it "ARRAY_REMOVE__1" do + binOpOnValue OpRemove (A.Array [A.Bool False, A.Null, A.Bool True, A.Bool True]) (A.Bool False) + `shouldBe` A.Array [A.Null, A.Bool True, A.Bool True] + + it "ARRAY_REMOVE__2" do + binOpOnValue OpRemove (A.Array [A.String "Foo", A.String "Bar", A.Null, A.String "baz"]) A.Null + `shouldBe` A.Array [A.String "Foo", A.String "Bar", A.String "baz"] + + it "ARRAY_SORT__0" do + unaryOpOnValue OpSort (A.Array [A.Number (-1), A.Number 2, A.Null, A.Number 0]) + `shouldBe` A.Array [A.Number (-1), A.Number 0, A.Number 2, A.Null] + + it "ARRAY_SORT__1" do + unaryOpOnValue OpSort (A.Array [A.Bool False, A.Null, A.Bool True]) + `shouldBe` A.Array [A.Bool False, A.Bool True, A.Null] + + it "ARRAY_SORT__2" do + unaryOpOnValue OpSort (A.Array [A.String "Foo", A.String "Bar", A.Null, A.String "baz"]) + `shouldBe` A.Array [A.String "Bar", A.String "Foo", A.String "baz", A.Null] + + it "ARRAY_UNION__0" do + (binOpOnValue OpUnion `on` (\xs -> A.Number <$> xs & A.Array)) + [1, 2, 3, 1, 2] [4, 1] `shouldBe` (\xs -> A.Number <$> xs & A.Array) [1, 2, 3, 4] + + it "ARRAY_UNION__1" do + binOpOnValue OpUnion (A.Array [A.String "apple", A.String "apple", A.Null, A.String "cherry"]) + (A.Array [A.String "cherry"]) `shouldBe` A.Array [A.String "apple", A.Null, A.String "cherry"] diff --git a/hstream-sql/test/HStream/SQL/Codegen/MathSpec.hs b/hstream-sql/test/HStream/SQL/Codegen/MathSpec.hs new file mode 100644 index 000000000..fce9ae0b4 --- /dev/null +++ b/hstream-sql/test/HStream/SQL/Codegen/MathSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HStream.SQL.Codegen.MathSpec where + +import qualified Data.Aeson as A +import Data.Function +import Data.Scientific +import HStream.SQL.AST +import HStream.SQL.Internal.Codegen +import Test.HUnit +import Test.Hspec + +spec :: Spec +spec = describe "Math Scalar Functions" do + +-- Arith Expr + + it "binary add" do + binOpOnValue OpAdd (A.Number 1) (A.Number 2) `shouldBe` (A.Number 3) + + it "floor" do + unaryOpOnValue OpFloor (A.Number 1.5) + `shouldBe` A.Number 1 + + it "ceil" do + unaryOpOnValue OpCeil (A.Number 1.5) `shouldBe` A.Number 2 diff --git a/hstream-sql/test/HStream/SQL/CodegenSpec.hs b/hstream-sql/test/HStream/SQL/CodegenSpec.hs deleted file mode 100644 index ef86e3f3a..000000000 --- a/hstream-sql/test/HStream/SQL/CodegenSpec.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module HStream.SQL.CodegenSpec where - -import qualified Data.Aeson as A -import HStream.SQL.AST -import HStream.SQL.Internal.Codegen -import Test.Hspec - -spec :: Spec -spec = describe "Scalar Functions" $ do - - it "binary add" $ do - binOpOnValue OpAdd (A.Number 1) (A.Number 2) `shouldBe` (A.Number 3) diff --git a/hstream-sql/test/HStream/SQL/ValidateSpec.hs b/hstream-sql/test/HStream/SQL/ValidateSpec.hs index 3ab684cb9..2516114ae 100644 --- a/hstream-sql/test/HStream/SQL/ValidateSpec.hs +++ b/hstream-sql/test/HStream/SQL/ValidateSpec.hs @@ -2,15 +2,62 @@ module HStream.SQL.ValidateSpec where -import Data.Either (isLeft) +import Data.Either (isLeft, isRight) import HStream.SQL.Abs import HStream.SQL.Internal.Validate import Test.Hspec spec :: Spec spec = describe "Validate Basic Data Types" $ do + let mkNothing :: BNFC'Position + mkNothing = Nothing :: BNFC'Position + + it "PNInteger" $ do + validate (PInteger mkNothing 807) `shouldSatisfy` isRight + validate (NInteger mkNothing 36) `shouldSatisfy` isRight + validate (IPInteger mkNothing 16) `shouldSatisfy` isRight + + it "PNDouble" $ do + validate (PDouble mkNothing 0.807) `shouldSatisfy` isRight + validate (IPDouble mkNothing 20.05) `shouldSatisfy` isRight + validate (NDouble mkNothing 15.00) `shouldSatisfy` isRight + + it "SString" $ do + validate (SString "netural term") `shouldSatisfy` isRight + + it "RawColumn" $ do + validate (RawColumn "Kaze no Yukue") `shouldSatisfy` isRight + + it "Boolean" $ do + validate (BoolTrue mkNothing) `shouldSatisfy` isRight + validate (BoolFalse mkNothing) `shouldSatisfy` isRight it "date" $ do - validate (DDate (Nothing :: BNFC'Position) + validate (DDate mkNothing (IPInteger Nothing 2021) (IPInteger Nothing 02) (IPInteger Nothing 29)) `shouldSatisfy` isLeft + validate (DDate mkNothing + (IPInteger Nothing 2020) (IPInteger Nothing 02) (IPInteger Nothing 29)) + `shouldSatisfy` isRight + validate (DDate mkNothing + (IPInteger Nothing 2005) (IPInteger Nothing 13) (IPInteger Nothing 29)) + `shouldSatisfy` isLeft + + it "time" $ do + validate (DTime mkNothing + (IPInteger Nothing 14) (IPInteger Nothing 61) (IPInteger Nothing 59)) + `shouldSatisfy` isLeft + validate (DTime mkNothing + (IPInteger Nothing 14) (IPInteger Nothing 16) (IPInteger Nothing 59)) + `shouldSatisfy` isRight + + it "Interval" $ do + validate (DInterval mkNothing (IPInteger mkNothing 13) (TimeUnitYear mkNothing)) + `shouldSatisfy` isRight + validate (DInterval mkNothing (NInteger mkNothing (-1)) (TimeUnitYear mkNothing)) + `shouldSatisfy` isRight + + it "ColName" $ do + validate (ColNameSimple mkNothing (Ident "col")) `shouldSatisfy` isRight + validate (ColNameStream mkNothing (Ident "stream") (Ident "col")) + `shouldSatisfy` isRight