Skip to content

Commit

Permalink
Merge pull request #2 from ndmitchell/master
Browse files Browse the repository at this point in the history 
Allow working with GHC HEAD
  • Loading branch information
@yav
yav committed Nov 12, 2014
2 parents a7dc43c + b7f0415 commit 8c6df51
Show file tree
Hide file tree
Showing 4 changed files with 109 additions and 86 deletions.
31 changes: 31 additions & 0 deletions .travis.yml
View file
@@ -0,0 +1,31 @@
env:
- GHCVER=7.0.4
- GHCVER=7.2.2
- GHCVER=7.4.2
- GHCVER=7.6.3
- GHCVER=7.8.3
- GHCVER=head

before_install:
- sudo add-apt-repository -y ppa:hvr/ghc
- sudo apt-get update
- sudo apt-get install cabal-install-head ghc-$GHCVER
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/head/bin:$PATH

install:
- cabal update
- cabal install --depend
- ghc --version

script:
- cabal configure -v2
- cabal build
- cabal sdist
- export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
cd dist/;
if [ -f "$SRC_TGZ" ]; then
cabal install "$SRC_TGZ";
else
echo "expected '$SRC_TGZ' not found";
exit 1;
fi
78 changes: 36 additions & 42 deletions Text/JSON/Parsec.hs
View file
Expand Up @@ -30,27 +30,27 @@ import Data.Char
import Numeric

p_value :: CharParser () JSValue
p_value = spaces *> p_jvalue
p_value = spaces **> p_jvalue

tok :: CharParser () a -> CharParser () a
tok p = p <* spaces
tok p = p <** spaces

p_jvalue :: CharParser () JSValue
p_jvalue = (JSNull <$ p_null)
<|> (JSBool <$> p_boolean)
<|> (JSArray <$> p_array)
<|> (JSString <$> p_js_string)
<|> (JSObject <$> p_js_object)
<|> (JSRational False <$> p_number)
p_jvalue = (JSNull <$$ p_null)
<|> (JSBool <$$> p_boolean)
<|> (JSArray <$$> p_array)
<|> (JSString <$$> p_js_string)
<|> (JSObject <$$> p_js_object)
<|> (JSRational False <$$> p_number)
<?> "JSON value"

p_null :: CharParser () ()
p_null = tok (string "null") >> return ()

p_boolean :: CharParser () Bool
p_boolean = tok
( (True <$ string "true")
<|> (False <$ string "false")
( (True <$$ string "true")
<|> (False <$$ string "false")
)

p_array :: CharParser () [JSValue]
Expand All @@ -62,62 +62,56 @@ p_string = between (tok (char '"')) (tok (char '"')) (many p_char)
where p_char = (char '\\' >> p_esc)
<|> (satisfy (\x -> x /= '"' && x /= '\\'))

p_esc = ('"' <$ char '"')
<|> ('\\' <$ char '\\')
<|> ('/' <$ char '/')
<|> ('\b' <$ char 'b')
<|> ('\f' <$ char 'f')
<|> ('\n' <$ char 'n')
<|> ('\r' <$ char 'r')
<|> ('\t' <$ char 't')
<|> (char 'u' *> p_uni)
p_esc = ('"' <$$ char '"')
<|> ('\\' <$$ char '\\')
<|> ('/' <$$ char '/')
<|> ('\b' <$$ char 'b')
<|> ('\f' <$$ char 'f')
<|> ('\n' <$$ char 'n')
<|> ('\r' <$$ char 'r')
<|> ('\t' <$$ char 't')
<|> (char 'u' **> p_uni)
<?> "escape character"

p_uni = check =<< count 4 (satisfy isHexDigit)
where check x | code <= max_char = pure (toEnum code)
| otherwise = empty
where check x | code <= max_char = return (toEnum code)
| otherwise = mzero
where code = fst $ head $ readHex x
max_char = fromEnum (maxBound :: Char)

p_object :: CharParser () [(String,JSValue)]
p_object = between (tok (char '{')) (tok (char '}'))
$ p_field `sepBy` tok (char ',')
where p_field = (,) <$> (p_string <* tok (char ':')) <*> p_jvalue
where p_field = (,) <$$> (p_string <** tok (char ':')) <**> p_jvalue

p_number :: CharParser () Rational
p_number = tok
$ do s <- getInput
case readSigned readFloat s of
[(n,s1)] -> n <$ setInput s1
_ -> empty
[(n,s1)] -> n <$$ setInput s1
_ -> mzero

p_js_string :: CharParser () JSString
p_js_string = toJSString <$> p_string
p_js_string = toJSString <$$> p_string

p_js_object :: CharParser () (JSObject JSValue)
p_js_object = toJSObject <$> p_object
p_js_object = toJSObject <$$> p_object

--------------------------------------------------------------------------------
-- XXX: Because Parsec is not Applicative yet...

pure :: a -> CharParser () a
pure = return
(<**>) :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
(<**>) = ap

(<*>) :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
(<*>) = ap
(**>) :: CharParser () a -> CharParser () b -> CharParser () b
(**>) = (>>)

(*>) :: CharParser () a -> CharParser () b -> CharParser () b
(*>) = (>>)
(<**) :: CharParser () a -> CharParser () b -> CharParser () a
m <** n = do x <- m; _ <- n; return x

(<*) :: CharParser () a -> CharParser () b -> CharParser () a
m <* n = do x <- m; _ <- n; return x
(<$$>) :: (a -> b) -> CharParser () a -> CharParser () b
(<$$>) = fmap

empty :: CharParser () a
empty = mzero

(<$>) :: (a -> b) -> CharParser () a -> CharParser () b
(<$>) = fmap

(<$) :: a -> CharParser () b -> CharParser () a
x <$ m = m >> return x
(<$$) :: a -> CharParser () b -> CharParser () a
x <$$ m = m >> return x

80 changes: 37 additions & 43 deletions Text/JSON/ReadP.hs
View file
Expand Up @@ -30,23 +30,23 @@ import Data.Char
import Numeric

token :: ReadP a -> ReadP a
token p = skipSpaces *> p
token p = skipSpaces **> p

p_value :: ReadP JSValue
p_value = (JSNull <$ p_null)
<|> (JSBool <$> p_boolean)
<|> (JSArray <$> p_array)
<|> (JSString <$> p_js_string)
<|> (JSObject <$> p_js_object)
<|> (JSRational False <$> p_number)
p_value = (JSNull <$$ p_null)
<||> (JSBool <$$> p_boolean)
<||> (JSArray <$$> p_array)
<||> (JSString <$$> p_js_string)
<||> (JSObject <$$> p_js_object)
<||> (JSRational False <$$> p_number)

p_null :: ReadP ()
p_null = token (string "null") >> return ()

p_boolean :: ReadP Bool
p_boolean = token
( (True <$ string "true")
<|> (False <$ string "false")
( (True <$$ string "true")
<||> (False <$$ string "false")
)

p_array :: ReadP [JSValue]
Expand All @@ -56,62 +56,56 @@ p_array = between (token (char '[')) (token (char ']'))
p_string :: ReadP String
p_string = between (token (char '"')) (char '"') (many p_char)
where p_char = (char '\\' >> p_esc)
<|> (satisfy (\x -> x /= '"' && x /= '\\'))

p_esc = ('"' <$ char '"')
<|> ('\\' <$ char '\\')
<|> ('/' <$ char '/')
<|> ('\b' <$ char 'b')
<|> ('\f' <$ char 'f')
<|> ('\n' <$ char 'n')
<|> ('\r' <$ char 'r')
<|> ('\t' <$ char 't')
<|> (char 'u' *> p_uni)
<||> (satisfy (\x -> x /= '"' && x /= '\\'))

p_esc = ('"' <$$ char '"')
<||> ('\\' <$$ char '\\')
<||> ('/' <$$ char '/')
<||> ('\b' <$$ char 'b')
<||> ('\f' <$$ char 'f')
<||> ('\n' <$$ char 'n')
<||> ('\r' <$$ char 'r')
<||> ('\t' <$$ char 't')
<||> (char 'u' **> p_uni)

p_uni = check =<< count 4 (satisfy isHexDigit)
where check x | code <= max_char = pure (toEnum code)
| otherwise = empty
where check x | code <= max_char = return (toEnum code)
| otherwise = pfail
where code = fst $ head $ readHex x
max_char = fromEnum (maxBound :: Char)

p_object :: ReadP [(String,JSValue)]
p_object = between (token (char '{')) (token (char '}'))
$ p_field `sepBy` token (char ',')
where p_field = (,) <$> (p_string <* token (char ':')) <*> p_value
where p_field = (,) <$$> (p_string <** token (char ':')) <**> p_value

p_number :: ReadP Rational
p_number = readS_to_P (readSigned readFloat)

p_js_string :: ReadP JSString
p_js_string = toJSString <$> p_string
p_js_string = toJSString <$$> p_string

p_js_object :: ReadP (JSObject JSValue)
p_js_object = toJSObject <$> p_object
p_js_object = toJSObject <$$> p_object

--------------------------------------------------------------------------------
-- XXX: Because ReadP is not Applicative yet...

pure :: a -> ReadP a
pure = return
(<**>) :: ReadP (a -> b) -> ReadP a -> ReadP b
(<**>) = ap

(<*>) :: ReadP (a -> b) -> ReadP a -> ReadP b
(<*>) = ap
(**>) :: ReadP a -> ReadP b -> ReadP b
(**>) = (>>)

(*>) :: ReadP a -> ReadP b -> ReadP b
(*>) = (>>)
(<**) :: ReadP a -> ReadP b -> ReadP a
m <** n = do x <- m; _ <- n; return x

(<*) :: ReadP a -> ReadP b -> ReadP a
m <* n = do x <- m; _ <- n; return x
(<||>) :: ReadP a -> ReadP a -> ReadP a
(<||>) = (+++)

empty :: ReadP a
empty = pfail
(<$$>) :: (a -> b) -> ReadP a -> ReadP b
(<$$>) = fmap

(<|>) :: ReadP a -> ReadP a -> ReadP a
(<|>) = (+++)

(<$>) :: (a -> b) -> ReadP a -> ReadP b
(<$>) = fmap

(<$) :: a -> ReadP b -> ReadP a
x <$ m = m >> return x
(<$$) :: a -> ReadP b -> ReadP a
x <$$ m = m >> return x

6 changes: 5 additions & 1 deletion json.cabal
View file
Expand Up @@ -16,7 +16,7 @@ license-file: LICENSE
author: Galois Inc.
maintainer: Iavor S. Diatchki (iavor.diatchki@gmail.com)
Copyright: (c) 2007-2009 Galois Inc.
cabal-version: >= 1.2.0
cabal-version: >= 1.6
build-type: Simple
extra-source-files:
CHANGES
Expand Down Expand Up @@ -64,6 +64,10 @@ extra-source-files:
tests/unit/pass2.json
tests/unit/pass3.json

source-repository head
type: git
location: https://github.com/GaloisInc/json.git

flag split-base
default: True
description: Use the new split base package.
Expand Down

0 comments on commit 8c6df51

Please sign in to comment.