Skip to content
This repository has been archived by the owner on Jun 15, 2023. It is now read-only.

Commit

Permalink
Update for Int -> HugeInt change in EJson
Browse files Browse the repository at this point in the history
  • Loading branch information
garyb committed Jun 30, 2017
1 parent 5b33444 commit c0a6d28
Show file tree
Hide file tree
Showing 6 changed files with 38 additions and 152 deletions.
9 changes: 5 additions & 4 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
7 changes: 3 additions & 4 deletions src/SqlSquared/Constructors.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ((∘))

Expand All @@ -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.LiteralInteger
int = embed ∘ Sig.LiteralIntegerHI.fromInt

num t. Corecursive t (Sig.SqlF EJsonF) Number t
num = embed ∘ Sig.LiteralDecimalHN.fromNumber
Expand Down
3 changes: 2 additions & 1 deletion src/SqlSquared/Lenses.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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')
Expand Down Expand Up @@ -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.LiteralEJ.Integer) $ project ⋙ case _ of
S.Literal (EJ.Integer r) → M.Just r
_ → M.Nothing
Expand Down
130 changes: 9 additions & 121 deletions src/SqlSquared/Parser/Tokenizer.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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 eqTokenLitEq Literal
Expand Down Expand Up @@ -202,121 +199,13 @@ notQuotedIdent = do
else pure str

stringLit m. Monad m P.ParserT String m Token
stringLit =
map (LitString)
$ 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 = LitString <$> EJP.parseStringLiteral

numLit m. Monad m P.ParserT String m Token
numLit = map (LitDecimal) parseDecimal
numLit = LitDecimal <$> EJP.parseDecimalLiteral

intLit m. Monad m P.ParserT String m Token
intLit = map (LitInteger) 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
NothingP.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 = LitInteger <$> EJP.parseHugeIntLiteral

keyword m. Monad m P.ParserT String m Token
keyword = map Kw $ PC.choice $ map (PC.try ∘ parseKeyWord) keywords
Expand All @@ -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
Expand Down
28 changes: 14 additions & 14 deletions src/SqlSquared/Signature.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
13 changes: 5 additions & 8 deletions test/src/Argonaut.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
JCursorTopS.Splice Nothing
JIndex i c → S.Binop { op: S.IndexDeref, lhs: JC c, rhs: I i }
Expand Down

0 comments on commit c0a6d28

Please sign in to comment.