diff --git a/bower.json b/bower.json index c28db7f..859a72c 100644 --- a/bower.json +++ b/bower.json @@ -15,13 +15,14 @@ "package.json" ], "dependencies": { - "purescript-prelude": "^3.0.0", + "purescript-prelude": "^3.1.0", "purescript-matryoshka": "^0.3.0", "purescript-pathy": "^4.0.0", - "purescript-profunctor": "^3.0.0", + "purescript-profunctor": "^3.2.0", "purescript-profunctor-lenses": "^3.2.0", - "purescript-ejson": "^9.0.0", - "purescript-argonaut-codecs": "^3.0.1" + "purescript-ejson": "^10.0.0", + "purescript-argonaut-codecs": "^3.1.0", + "purescript-strongcheck": "^3.1.0" }, "devDependencies": { "purescript-argonaut": "^3.0.0", diff --git a/src/SqlSquare.purs b/src/SqlSquared.purs similarity index 100% rename from src/SqlSquare.purs rename to src/SqlSquared.purs diff --git a/src/SqlSquare/Constructors.purs b/src/SqlSquared/Constructors.purs similarity index 98% rename from src/SqlSquare/Constructors.purs rename to src/SqlSquared/Constructors.purs index 3496749..a54e7b7 100644 --- a/src/SqlSquare/Constructors.purs +++ b/src/SqlSquared/Constructors.purs @@ -3,15 +3,14 @@ module SqlSquared.Constructors where import Prelude import Data.Array as Arr -import Data.Json.Extended.Signature (EJsonF(..), EJsonMap(..)) import Data.Foldable as F +import Data.HugeInt as HI import Data.HugeNum as HN +import Data.Json.Extended.Signature (EJsonF(..), EJsonMap(..)) import Data.List as L import Data.Map as Map import Data.Maybe (Maybe(..)) - import Matryoshka (class Corecursive, embed) - import SqlSquared.Signature as Sig import SqlSquared.Utils ((∘)) @@ -25,7 +24,7 @@ null ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ t null = embed $ Sig.Literal Null int ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Int → t -int = embed ∘ Sig.Literal ∘ Integer +int = embed ∘ Sig.Literal ∘ Integer ∘ HI.fromInt num ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Number → t num = embed ∘ Sig.Literal ∘ Decimal ∘ HN.fromNumber diff --git a/src/SqlSquare/Lenses.purs b/src/SqlSquared/Lenses.purs similarity index 99% rename from src/SqlSquare/Lenses.purs rename to src/SqlSquared/Lenses.purs index b560c71..ff99207 100644 --- a/src/SqlSquare/Lenses.purs +++ b/src/SqlSquared/Lenses.purs @@ -2,6 +2,7 @@ module SqlSquared.Lenses where import Prelude +import Data.HugeInt as HI import Data.HugeNum as HN import Data.Json.Extended as EJ import Data.Lens (Prism', prism', Lens', lens, Iso') @@ -241,7 +242,7 @@ _IntLiteral ∷ ∀ t . Recursive t (S.SqlF EJ.EJsonF) ⇒ Corecursive t (S.SqlF EJ.EJsonF) - ⇒ Prism' t Int + ⇒ Prism' t HI.HugeInt _IntLiteral = prism' (embed ∘ S.Literal ∘ EJ.Integer) $ project ⋙ case _ of S.Literal (EJ.Integer r) → M.Just r _ → M.Nothing diff --git a/src/SqlSquare/Parser.purs b/src/SqlSquared/Parser.purs similarity index 100% rename from src/SqlSquare/Parser.purs rename to src/SqlSquared/Parser.purs diff --git a/src/SqlSquare/Parser/Tokenizer.purs b/src/SqlSquared/Parser/Tokenizer.purs similarity index 64% rename from src/SqlSquare/Parser/Tokenizer.purs rename to src/SqlSquared/Parser/Tokenizer.purs index 0f03515..cebccb8 100644 --- a/src/SqlSquare/Parser/Tokenizer.purs +++ b/src/SqlSquared/Parser/Tokenizer.purs @@ -7,26 +7,23 @@ module SqlSquared.Parser.Tokenizer import Prelude import Control.Alt ((<|>)) - import Data.Array as A -import Data.Int as Int +import Data.Char as Ch import Data.Either (Either) -import Data.Maybe (Maybe(..), isJust) -import Data.Foldable as F +import Data.HugeInt as HI import Data.HugeNum as HN -import Data.Char as Ch +import Data.Json.Extended.Signature.Parse as EJP +import Data.Maybe (isJust) import Data.String as S - import SqlSquared.Utils ((∘)) - import Text.Parsing.Parser as P import Text.Parsing.Parser.Combinators as PC -import Text.Parsing.Parser.Token as PT import Text.Parsing.Parser.String as PS +import Text.Parsing.Parser.Token as PT data Literal = String String - | Integer Int + | Integer HI.HugeInt | Decimal HN.HugeNum derive instance eqTokenLit ∷ Eq Literal @@ -202,121 +199,13 @@ notQuotedIdent = do else pure str stringLit ∷ ∀ m. Monad m ⇒ P.ParserT String m Token -stringLit = - map (Lit ∘ String) - $ PC.between (PS.string "\"") (PS.string "\"") - $ map S.fromCharArray - $ A.many stringChar - where - stringChar = PC.try stringEscape <|> stringLetter - stringLetter = PS.satisfy (not ∘ eq '"') - stringEscape = PS.string "\\\"" $> '"' +stringLit = Lit ∘ String <$> EJP.parseStringLiteral numLit ∷ ∀ m. Monad m ⇒ P.ParserT String m Token -numLit = map (Lit ∘ Decimal) parseDecimal +numLit = Lit ∘ Decimal <$> EJP.parseDecimalLiteral intLit ∷ ∀ m. Monad m ⇒ P.ParserT String m Token -intLit = map (Lit ∘ Integer) parseIntLiteral - -parseIntLiteral ∷ ∀ m. Monad m ⇒ P.ParserT String m Int -parseIntLiteral = parseSigned parseNat - -parseDecimal ∷ ∀ m. Monad m ⇒ P.ParserT String m HN.HugeNum -parseDecimal = parseHugeNum <|> parseScientific - -parseHugeNum ∷ ∀ m. Monad m ⇒ P.ParserT String m HN.HugeNum -parseHugeNum = do - chars ← - map S.fromCharArray - $ A.many - $ PS.oneOf - $ digits - <> [ '-', '.' ] - case HN.fromString chars of - Just num → pure num - Nothing → P.fail $ "Failed to parse decimal: " <> chars - -parseDigit ∷ ∀ m. Monad m ⇒ P.ParserT String m Int -parseDigit = - PC.choice - [ 0 <$ PS.string "0" - , 1 <$ PS.string "1" - , 2 <$ PS.string "2" - , 3 <$ PS.string "3" - , 4 <$ PS.string "4" - , 5 <$ PS.string "5" - , 6 <$ PS.string "6" - , 7 <$ PS.string "7" - , 8 <$ PS.string "8" - , 9 <$ PS.string "9" - ] - -parseScientific ∷ ∀ m. Monad m ⇒ P.ParserT String m HN.HugeNum -parseScientific = - parseSigned parsePositiveScientific - -parseNat - ∷ ∀ m - . Monad m - ⇒ P.ParserT String m Int -parseNat = - A.some parseDigit - <#> F.foldl (\a i → a * 10 + i) 0 - -parseNegative - ∷ ∀ m a - . Monad m - ⇒ Ring a - ⇒ P.ParserT String m a - → P.ParserT String m a -parseNegative p = - PS.string "-" - *> PS.skipSpaces - *> p - <#> negate - -parsePositive - ∷ ∀ m a - . Monad m - ⇒ Ring a - ⇒ P.ParserT String m a - → P.ParserT String m a -parsePositive p = - PC.optional (PS.string "+" *> PS.skipSpaces) - *> p - -parseSigned - ∷ ∀ m a - . Monad m - ⇒ Ring a - ⇒ P.ParserT String m a - → P.ParserT String m a -parseSigned p = parseNegative p <|> parsePositive p - -parseExponent - ∷ ∀ m - . Monad m - ⇒ P.ParserT String m Int -parseExponent = - (PS.string "e" <|> PS.string "E") - *> parseIntLiteral - -parsePositiveScientific ∷ ∀ m. Monad m ⇒ P.ParserT String m HN.HugeNum -parsePositiveScientific = do - let ten = HN.fromNumber 10.0 - lhs ← PC.try $ fromInt <$> parseNat <* PS.string "." - rhs ← A.many parseDigit <#> F.foldr (\d f → divNum (f + fromInt d) ten) zero - exp ← parseExponent - pure $ (lhs + rhs) * HN.pow ten exp - - where - fromInt = HN.fromNumber <<< Int.toNumber - - -- TODO: remove when HugeNum adds division - divNum a b = - HN.fromNumber $ - HN.toNumber a / HN.toNumber b - +intLit = Lit ∘ Integer <$> EJP.parseHugeIntLiteral keyword ∷ ∀ m. Monad m ⇒ P.ParserT String m Token keyword = map Kw $ PC.choice $ map (PC.try ∘ parseKeyWord) keywords @@ -329,7 +218,6 @@ parseKeyWord s = c ← PC.try $ PS.oneOf [ Ch.toUpper ch, Ch.toLower ch ] pure $ A.snoc acc c - tokens ∷ ∀ m. Monad m ⇒ P.ParserT String m (Array Token) tokens = do PS.skipSpaces diff --git a/src/SqlSquare/Signature.purs b/src/SqlSquared/Signature.purs similarity index 98% rename from src/SqlSquare/Signature.purs rename to src/SqlSquared/Signature.purs index e3660db..de1e326 100644 --- a/src/SqlSquare/Signature.purs +++ b/src/SqlSquared/Signature.purs @@ -43,38 +43,38 @@ module SqlSquared.Signature import Prelude +import Control.Monad.Gen as MGen import Data.Argonaut as J import Data.Array as A import Data.Either as E import Data.Eq (class Eq1, eq1) import Data.Foldable as F -import Data.Json.Extended as EJ +import Data.HugeInt as HI +import Data.HugeNum as HN import Data.Int as Int -import Data.List as L +import Data.Json.Extended as EJ import Data.List ((:)) -import Data.HugeNum as HN +import Data.List as L import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) import Data.Newtype (class Newtype) +import Data.NonEmpty ((:|)) import Data.Ord (class Ord1, compare1) import Data.String as S +import Data.String.Gen as GenS import Data.Traversable as T - import Matryoshka (Algebra, CoalgebraM, class Corecursive, embed) - -import SqlSquared.Utils (type (×), (×), (∘), (⋙)) - import SqlSquared.Signature.BinaryOperator as BO import SqlSquared.Signature.Case as CS import SqlSquared.Signature.GroupBy as GB +import SqlSquared.Signature.Ident as ID import SqlSquared.Signature.JoinType as JT import SqlSquared.Signature.OrderBy as OB import SqlSquared.Signature.OrderType as OT import SqlSquared.Signature.Projection as PR import SqlSquared.Signature.Relation as RL import SqlSquared.Signature.UnaryOperator as UO -import SqlSquared.Signature.Ident as ID - +import SqlSquared.Utils (type (×), (×), (∘), (⋙)) import Test.StrongCheck.Arbitrary as SC import Test.StrongCheck.Gen as Gen @@ -915,11 +915,11 @@ genSql n genLeaf ∷ ∀ t. GenSql t genLeaf = map (embed ∘ Literal) - $ Gen.oneOf (pure $ EJ.Null) - [ map EJ.Boolean SC.arbitrary - , map EJ.Integer SC.arbitrary - , map EJ.Decimal $ map HN.fromNumber SC.arbitrary - , map EJ.String SC.arbitrary + $ MGen.oneOf $ pure EJ.Null :| + [ EJ.Boolean <$> MGen.chooseBool + , EJ.Integer <<< HI.fromInt <$> MGen.chooseInt (-1000000) 1000000 + , EJ.Decimal <<< HN.fromNumber <$> MGen.chooseFloat (-1000000.0) 1000000.0 + , EJ.String <$> GenS.genUnicodeString ] genLetP ∷ ∀ t. Int → GenSql t diff --git a/src/SqlSquare/Signature/BinaryOperator.purs b/src/SqlSquared/Signature/BinaryOperator.purs similarity index 100% rename from src/SqlSquare/Signature/BinaryOperator.purs rename to src/SqlSquared/Signature/BinaryOperator.purs diff --git a/src/SqlSquare/Signature/Case.purs b/src/SqlSquared/Signature/Case.purs similarity index 100% rename from src/SqlSquare/Signature/Case.purs rename to src/SqlSquared/Signature/Case.purs diff --git a/src/SqlSquare/Signature/GroupBy.purs b/src/SqlSquared/Signature/GroupBy.purs similarity index 100% rename from src/SqlSquare/Signature/GroupBy.purs rename to src/SqlSquared/Signature/GroupBy.purs diff --git a/src/SqlSquare/Signature/Ident.purs b/src/SqlSquared/Signature/Ident.purs similarity index 100% rename from src/SqlSquare/Signature/Ident.purs rename to src/SqlSquared/Signature/Ident.purs diff --git a/src/SqlSquare/Signature/JoinType.purs b/src/SqlSquared/Signature/JoinType.purs similarity index 100% rename from src/SqlSquare/Signature/JoinType.purs rename to src/SqlSquared/Signature/JoinType.purs diff --git a/src/SqlSquare/Signature/OrderBy.purs b/src/SqlSquared/Signature/OrderBy.purs similarity index 100% rename from src/SqlSquare/Signature/OrderBy.purs rename to src/SqlSquared/Signature/OrderBy.purs diff --git a/src/SqlSquare/Signature/OrderType.purs b/src/SqlSquared/Signature/OrderType.purs similarity index 100% rename from src/SqlSquare/Signature/OrderType.purs rename to src/SqlSquared/Signature/OrderType.purs diff --git a/src/SqlSquare/Signature/Projection.purs b/src/SqlSquared/Signature/Projection.purs similarity index 100% rename from src/SqlSquare/Signature/Projection.purs rename to src/SqlSquared/Signature/Projection.purs diff --git a/src/SqlSquare/Signature/Relation.purs b/src/SqlSquared/Signature/Relation.purs similarity index 100% rename from src/SqlSquare/Signature/Relation.purs rename to src/SqlSquared/Signature/Relation.purs diff --git a/src/SqlSquare/Signature/UnaryOperator.purs b/src/SqlSquared/Signature/UnaryOperator.purs similarity index 100% rename from src/SqlSquare/Signature/UnaryOperator.purs rename to src/SqlSquared/Signature/UnaryOperator.purs diff --git a/src/SqlSquare/Utils.purs b/src/SqlSquared/Utils.purs similarity index 100% rename from src/SqlSquare/Utils.purs rename to src/SqlSquared/Utils.purs diff --git a/test/src/Argonaut.purs b/test/src/Argonaut.purs index d0ca7f3..6f7e32a 100644 --- a/test/src/Argonaut.purs +++ b/test/src/Argonaut.purs @@ -8,29 +8,26 @@ import Data.Argonaut (JCursor(..), jsonParser) import Data.Argonaut as JS import Data.Either (fromRight) import Data.Foldable as F +import Data.HugeInt as HI +import Data.Json.Extended.Signature (EJsonF(..)) import Data.List ((:)) import Data.List as L import Data.Maybe (Maybe(..)) import Data.Set as Set import Data.Tuple (Tuple, fst) -import Data.Json.Extended.Signature (EJsonF(..)) - +import Matryoshka (ana, elgotPara, Coalgebra, ElgotAlgebra) +import Partial.Unsafe (unsafePartial) import SqlSquared as S import SqlSquared.Utils ((×), (∘), (⋙)) - -import Matryoshka (ana, elgotPara, Coalgebra, ElgotAlgebra) - import Test.Unit (suite, test, TestSuite) import Test.Unit.Assert as Assert -import Partial.Unsafe (unsafePartial) - data UnfoldableJC = JC JCursor | S String | I Int jcCoalgebra ∷ Coalgebra (S.SqlF EJsonF) UnfoldableJC jcCoalgebra = case _ of S s → S.Ident s - I i → S.Literal (Integer i) + I i → S.Literal (Integer (HI.fromInt i)) JC cursor → case cursor of JCursorTop → S.Splice Nothing JIndex i c → S.Binop { op: S.IndexDeref, lhs: JC c, rhs: I i }