I'm parsing some data I don't control. I have values that are an array of strings. They can either be normal strings, a string representation of a number, or a number with quotes around it.
["This is just a string", "\"5\"", "3"]
I would like to write a function toValue that converts them into the appropriate type to be converted to JSON.
toValue :: (ToJSON a) => String -> a
toValue (if a number) = parseInt
toValue (if a quoted number) = parseInt . stripQuotes
toValue _ = id
I would like to strip the quotes if it is a number surrounded by quotes, then convert it to a number if a number, otherwise pass it back as a string.
Can I do this with pattern matching? Some other way?
import Data.Char
import Data.Bool
parse a#('"':n:'"':[]) = bool (Left a) (Right (read [n] :: Int)) (isNumber n)
parse a#('"':n:m:'"':[]) = bool (Left a) (Right (read [n,n] :: Int)) (isNumber n && isNumber m)
parse a#(n:[]) = bool (Left a) (Right (read [n] :: Int)) (isNumber n)
parse a#(n:m:[]) = bool (Left a) (Right (read [n,n] :: Int)) (isNumber n && isNumber m)
parse xs = Left xs
> map parse ["This is just a string", "\"5\"", "3"]
[Left "This is just a string",Right 5,Right 3]
then, you can use either function from Data.Either module to encode number (Rights) and string (Lefts) to JSON.
Writing a function toValue :: ToJSON a => String -> a as you are proposing is not so hard: let us simply make toValue a method of the class ToJSON
class ToJSON a where
toValue :: String -> a
and then define the instance for Int as
instance ToJSON Int where
toValue s#('\"' : _) = read (read s) -- with quotes
toValue s = read s -- without quotes
The instance for String is slightly more involved (as String is a synonym for [Char]) but by no means rocket science:
class ToJSONList a where
toValues :: String -> [a]
instance ToJSONList Char where
toValues = id
instance ToJSONList a => ToJSON [a] where
toValue = toValues
Now, testing it in an interactive session, we have:
> toValue "This is just a string" :: String
"This is just a string"
> toValue "\"5\"" :: Int
5
> toValue "3" :: Int
3
However, from your question it seems that you have a use case that is not well supported by such a function toValue, i.e., to convert all elements of a list to their appropriate JSON-representation. To do so, you probably want to introduce an algebraic datatype for representing JSON-values:
data JSON = JInt Int | JString String deriving Show
and then have function toJSON that takes strings to their most appropriate JSON-representation:
toJSON :: String -> JSON
toJSON s =
case reads s of
[(n, "")] -> JInt n -- Int, no quotes
_ -> case reads s of
[(s, "")] -> case reads s of
[(n, "")] -> JInt n -- Int, quotes
_ -> JString s -- String, quotes
_ -> JString s -- String, no quotes
Indeed, to answer that part of your question, this function is defined just by (nested) pattern matching. However, if the (grammar of the) language you need to parse becomes more complicated then just integer literals, quoted integer literals, and string literals, this way of defining parsers quickly becomes to clumsy and error-prone, and you may want to start looking into parser combinators or parser generators then.
For your simple language of JSON values, this is arguably still fine though. Here is a simple example in an interactive session:
> map toJSON ["This is just a string", "\"5\"", "3"]
[JString "This is just a string",JInt 5,JInt 3]
Related
I made this function in Python:
def calc(a): return lambda op: {
'+': lambda b: calc(a+b),
'-': lambda b: calc(a-b),
'=': a}[op]
So you can make a calculation like this:
calc(1)("+")(1)("+")(10)("-")(7)("=")
And the result will be 5.
I wanbt to make the same function in Haskell to learn about lambdas, but I am getting parse errors.
My code looks like this:
calc :: Int -> (String -> Int)
calc a = \ op
| op == "+" = \ b calc a+b
| op == "-" = \ b calc a+b
| op == "=" = a
main = calc 1 "+" 1 "+" 10 "-" 7 "="
There are numerous syntactical problems with the code you have posted. I won't address them here, though: you will discover them yourself after going through a basic Haskell tutorial. Instead I'll focus on a more fundamental problem with the project, which is that the types don't really work out. Then I'll show a different approach that gets you the same outcome, to show you it is possible in Haskell once you've learned more.
While it's fine in Python to sometimes return a function-of-int and sometimes an int, this isn't allowed in Haskell. GHC has to know at compile time what type will be returned; you can't make that decision at runtime based on whether a string is "=" or not. So you need a different type for the "keep calcing" argument than the "give me the answer" argument.
This is possible in Haskell, and in fact is a technique with a lot of applications, but it's maybe not the best place for a beginner to start. You are inventing continuations. You want calc 1 plus 1 plus 10 minus 7 equals to produce 5, for some definitions of the names used therein. Achieving this requires some advanced features of the Haskell language and some funny types1, which is why I say it is not for beginners. But, below is an implementation that meets this goal. I won't explain it in detail, because there is too much for you to learn first. Hopefully after some study of Haskell fundamentals, you can return to this interesting problem and understand my solution.
calc :: a -> (a -> r) -> r
calc x k = k x
equals :: a -> a
equals = id
lift2 :: (a -> a -> a) -> a -> a -> (a -> r) -> r
lift2 f x y = calc (f x y)
plus :: Num a => a -> a -> (a -> r) -> r
plus = lift2 (+)
minus :: Num a => a -> a -> (a -> r) -> r
minus = lift2 (-)
ghci> calc 1 plus 1 plus 10 minus 7 equals
5
1 Of course calc 1 plus 1 plus 10 minus 7 equals looks a lot like 1 + 1 + 10 - 7, which is trivially easy. The important difference here is that these are infix operators, so this is parsed as (((1 + 1) + 10) - 7), while the version you're trying to implement in Python, and my Haskell solution, are parsed like ((((((((calc 1) plus) 1) plus) 10) minus) 7) equals) - no sneaky infix operators, and calc is in control of all combinations.
chi's answer says you could do this with "convoluted type class machinery", like printf does. Here's how you'd do that:
{-# LANGUAGE ExtendedDefaultRules #-}
class CalcType r where
calc :: Integer -> String -> r
instance CalcType r => CalcType (Integer -> String -> r) where
calc a op
| op == "+" = \ b -> calc (a+b)
| op == "-" = \ b -> calc (a-b)
instance CalcType Integer where
calc a op
| op == "=" = a
result :: Integer
result = calc 1 "+" 1 "+" 10 "-" 7 "="
main :: IO ()
main = print result
If you wanted to make it safer, you could get rid of the partiality with Maybe or Either, like this:
{-# LANGUAGE ExtendedDefaultRules #-}
class CalcType r where
calcImpl :: Either String Integer -> String -> r
instance CalcType r => CalcType (Integer -> String -> r) where
calcImpl a op
| op == "+" = \ b -> calcImpl (fmap (+ b) a)
| op == "-" = \ b -> calcImpl (fmap (subtract b) a)
| otherwise = \ b -> calcImpl (Left ("Invalid intermediate operator " ++ op))
instance CalcType (Either String Integer) where
calcImpl a op
| op == "=" = a
| otherwise = Left ("Invalid final operator " ++ op)
calc :: CalcType r => Integer -> String -> r
calc = calcImpl . Right
result :: Either String Integer
result = calc 1 "+" 1 "+" 10 "-" 7 "="
main :: IO ()
main = print result
This is rather fragile and very much not recommended for production use, but there it is anyway just as something to (eventually?) learn from.
Here is a simple solution that I'd say corresponds more closely to your Python code than the advanced solutions in the other answers. It's not an idiomatic solution because, just like your Python one, it will use runtime failure instead of types in the compiler.
So, the essence in you Python is this: you return either a function or an int. In Haskell it's not possible to return different types depending on runtime values, however it is possible to return a type that can contain different data, including functions.
data CalcResult = ContinCalc (Int -> String -> CalcResult)
| FinalResult Int
calc :: Int -> String -> CalcResult
calc a "+" = ContinCalc $ \b -> calc (a+b)
calc a "-" = ContinCalc $ \b -> calc (a-b)
calc a "=" = FinalResult a
For reasons that will become clear at the end, I would actually propose the following variant, which is, unlike typical Haskell, not curried:
calc :: (Int, String) -> CalcResult
calc (a,"+") = ContinCalc $ \b op -> calc (a+b,op)
calc (a,"-") = ContinCalc $ \b op -> calc (a-b,op)
calc (a,"=") = FinalResult a
Now, you can't just pile on function applications on this, because the result is never just a function – it can only be a wrapped function. Because applying more arguments than there are functions to handle them seems to be a failure case, the result should be in the Maybe monad.
contin :: CalcResult -> (Int, String) -> Maybe CalcResult
contin (ContinCalc f) (i,op) = Just $ f i op
contin (FinalResult _) _ = Nothing
For printing a final result, let's define
printCalcRes :: Maybe CalcResult -> IO ()
printCalcRes (Just (FinalResult r)) = print r
printCalcRes (Just _) = fail "Calculation incomplete"
printCalcRes Nothing = fail "Applied too many arguments"
And now we can do
ghci> printCalcRes $ contin (calc (1,"+")) (2,"=")
3
Ok, but that would become very awkward for longer computations. Note that we have after two operations a Maybe CalcResult so we can't just use contin again. Also, the parentheses that would need to be matched outwards are a pain.
Fortunately, Haskell is not Lisp and supports infix operators. And because we're anyways getting Maybe in the result, might as well include the failure case in the data type.
Then, the full solution is this:
data CalcResult = ContinCalc ((Int,String) -> CalcResult)
| FinalResult Int
| TooManyArguments
calc :: (Int, String) -> CalcResult
calc (a,"+") = ContinCalc $ \(b,op) -> calc (a+b,op)
calc (a,"-") = ContinCalc $ \(b,op) -> calc (a-b,op)
calc (a,"=") = FinalResult a
infixl 9 #
(#) :: CalcResult -> (Int, String) -> CalcResult
ContinCalc f # args = f args
_ # _ = TooManyArguments
printCalcRes :: CalcResult -> IO ()
printCalcRes (FinalResult r) = print r
printCalcRes (ContinCalc _) = fail "Calculation incomplete"
printCalcRes TooManyArguments = fail "Applied too many arguments"
Which allows to you write
ghci> printCalcRes $ calc (1,"+") # (2,"+") # (3,"-") # (4,"=")
2
A Haskell function of type A -> B has to return a value of the fixed type B every time it's called (or fail to terminate, or throw an exception, but let's neglect that).
A Python function is not similarly constrained. The returned value can be anything, with no type constraints. As a simple example, consider:
def foo(b):
if b:
return 42 # int
else:
return "hello" # str
In the Python code you posted, you exploit this feature to make calc(a)(op) to be either a function (a lambda) or an integer.
In Haskell we can't do that. This is to ensure that the code can be type checked at compile-time. If we write
bar :: String -> Int
bar s = foo (reverse (reverse s) == s)
the compiler can't be expected to verify that the argument always evaluates to True -- that would be undecidable, in general. The compiler merely requires that the type of foo is something like Bool -> Int. However, we can't assign that type to the definition of foo shown above.
So, what we can actually do in Haskell?
One option could be to abuse type classes. There is a way in Haskell to create a kind of "variadic" function exploiting some kind-of convoluted type class machinery. That would make
calc 1 "+" 1 "+" 10 "-" 7 :: Int
type-check and evaluate to the wanted result. I'm not attempting that: it's complex and "hackish", at least in my eye. This hack was used to implement printf in Haskell, and it's not pretty to read.
Another option is to create a custom data type and add some infix operator to the calling syntax. This also exploits some advanced feature of Haskell to make everything type check.
{-# LANGUAGE GADTs, FunctionalDependencies, TypeFamilies, FlexibleInstances #-}
data R t where
I :: Int -> R String
F :: (Int -> Int) -> R Int
instance Show (R String) where
show (I i) = show i
type family Other a where
Other String = Int
Other Int = String
(#) :: R a -> a -> R (Other a)
I i # "+" = F (i+) -- equivalent to F (\x -> i + x)
I i # "-" = F (i-) -- equivalent to F (\x -> i - x)
F f # i = I (f i)
I _ # s = error $ "unsupported operator " ++ s
main :: IO ()
main =
print (I 1 # "+" # 1 # "+" # 10 # "-" # 7)
The last line prints 5 as expected.
The key ideas are:
The type R a represents an intermediate result, which can be an integer or a function. If it's an integer, we remember that the next thing in the line should be a string by making I i :: R String. If it's a function, we remember the next thing should be an integer by having F (\x -> ...) :: R Int.
The operator (#) takes an intermediate result of type R a, a next "thing" (int or string) to process of type a, and produces a value in the "other type" Other a. Here, Other a is defined as the type Int (respectively String) when a is String (resp. Int).
I have a json object with a manually crafted ToJSON instance. I would like to replace this with a function that does not require my explicit enumeration of the key names.
I am using "rec*" as a prefix I would like to strip, and my fields start out as Text rather than string.
Starting with minimal data:
data R3 = R3 { recCode :: Code
, recValue :: Value} deriving (Show, Generic)
And smart constructor function:
makeR3 rawcode rawval = R3 code value where
code = rawcode
value = rawval
This implementation works fine:
instance ToJSON R3 where
toJSON (R3 recCode recValue) = object [ "code" .= recCode, "value" .= recValue]
But as you can imagine, typing out every key name by hand from "code" to "recCode" is not something I want to do.
tmp_r3 = makeR3 "TD" "100.42"
as_json = encode tmp_r3
main = do
let out = encodeToLazyText tmp_r3
I.putStrLn out
I.writeFile "./so.json" out
return ()
Output is correct:
{"value":100.42,"code":"TD"}
-- not recValue and recCode, correct!
However, when I try this function, it becomes unable to convert the text to string as it had automatically before.
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = T.toLower . IHaskellPrelude.drop 3 }
Output:
<interactive>:8:35: error:
• Couldn't match type ‘Text’ with ‘String’
Expected type: String -> String
Actual type: String -> Text
• In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}’
In the expression: genericToJSON defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}
<interactive>:8:47: error:
• Couldn't match type ‘String’ with ‘Text’
Expected type: String -> Text
Actual type: String -> String
• In the second argument of ‘(.)’, namely ‘IHaskellPrelude.drop 3’
In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = toLower . IHaskellPrelude.drop 3}’
The error itself is clear enough that Text doesn't work, but what should I change to strip my prefixes from keynames functionally in json output
and also correctly convert text to string?
I am also a little confused that I didn't change my input, it was Text type in both instances, but the first implementation was OK to work with it, while the second was not.
I am working in an ihaskell jupyter notebook.
Update
When I use the Data.Char recommended in answers below:
import Data.Char(toLower)
In:
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3 }
I get:
<interactive>:8:35: error:
• Couldn't match type ‘Char’ with ‘String’
Expected type: String -> String
Actual type: String -> Char
• In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}’
In the expression: genericToJSON defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}
<interactive>:8:55: error:
• Couldn't match type ‘String’ with ‘Char’
Expected type: String -> Char
Actual type: String -> String
• In the second argument of ‘(.)’, namely ‘IHaskellPrelude.drop 3’
In the ‘fieldLabelModifier’ field of a record
In the first argument of ‘genericToJSON’, namely ‘defaultOptions {fieldLabelModifier = Data.Char.toLower . IHaskellPrelude.drop 3}’
And when I try a naked "drop" rather than an IHaskellPrelude drop, I get:
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = Data.Char.toLower . drop 3 }
<interactive>:8:55: error:
Ambiguous occurrence ‘drop’
It could refer to either ‘BS.drop’, imported from ‘Data.ByteString’
or ‘IHaskellPrelude.drop’, imported from ‘Prelude’ (and originally defined in ‘GHC.List’)
or ‘T.drop’, imported from ‘Data.Text’
You seem to be using toLower from Data.Text, which works with Text, not with String, so quite naturally, it doesn't fit there.
Instead, you could use toLower from Data.Char and map it over the String:
fieldLabelModifier = map toLower . drop 3
You compose two function T.toLower and drop 3, but the types do not match. Indeed, if we lookup the types, we see toLower :: Text -> Text and drop :: Int -> [a] -> [a]. A String is a list of Chars, but Text is not: a Text can be seen as a packed "block" of characters.
We can however compose a function of type String -> String, the type of the field fieldLabelModifier :: String -> String:
import Data.Char(toLower)
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = map toLower . drop 3
}
We thus use the toLower :: Char -> Char function of the Data.Char module, and perform a mapping, such that all characters in the string are mapped.
Note that if you simply want to derive FromJson and ToJSON with different options, you can make use of template Haskell, like:
{-# LANGUAGE DeriveGeneric, TemplateHaskell #-}
import Data.Char(toUpper)
import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))
data Test = Test { attribute :: String } deriving Show
$(deriveJSON defaultOptions {fieldLabelModifier = map toUpper . drop 3} ''Test)
In that case the template Haskell part will implement the FromJSON and ToJSON instances.
Note: We can use qualified imports in order to make it more clear what function we use, for example:
import qualified Data.List as L
import qualified Data.Char as C
instance ToJSON R3 where
toJSON = genericToJSON defaultOptions {
fieldLabelModifier = map C.toLower . L.drop 3
}
Note: As for the smart constructor, you can simplify this expression to:
makeR3 = R3
I am trying to write a function that will take a JSON object, make a change to every string value in it and return a new JSON object. So far my code is:
applyContext :: FromJSON a => a -> a
applyContext x =
case x of
Array _ -> map applyContext x
Object _ -> map applyContext x
String _ -> parseValue x
_ -> x
However, the compiler complains about second second case line:
Couldn't match expected type `[b0]' with actual type `a'
`a' is a rigid type variable bound by
the type signature for:
applyContext :: forall a. FromJSON a => a -> a
at app\Main.hs:43:17
I'm guessing that is because map is meant to work on lists, but I would have naively expected it to use Data.HashMap.Lazy.map instead, since that is what the type actually is in that case. If I explicitly use that function I get
Couldn't match expected type `HashMap.HashMap k0 v20' with actual type `a'
which also makes sense, since I haven't constrained a to that extent because then it wouldn't work for the other cases. I suspect that if I throw enough explicit types at this I could make it work but it feels like it should be a lot simpler. What is an idiomatic way of writing this function, or if this is good then what would be the simplest way of getting the types right?
First of all, what FromJSON a => a does mean? It's type of some thing what says: it can be thing with any type but only from class FromJSON. This class can contain types which very differently constructed and you can't do any pattern matching. You can only do what is specified in the class FromJSON declaration by programmer. Basically, there is one method parseJSON :: FromJSON a => Value -> Parser a.
Secondly, you should use some isomorphic representation of JSON for your work. The type Value is good one. So, you can do the main work by the function like Value -> Value. After that, you can compose this fuction with parseJSON and toJSON for generalse types.
Like this:
change :: Value -> Value
change (Array x) = Array . fmap change $ x
change (Object x) = Object . fmap change $ x
change (String x) = Object . parseValue $ x
change x = x
apply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> Result b
apply change = fromJSON . change . toJSON
unsafeApply :: (ToJSON a, FromJSON b) => (Value -> Value) -> a -> b
unsafeApply change x = case apply change x of
Success x -> x
Error msg -> error $ "unsafeApply: " ++ msg
applyContext :: (ToJSON a, FromJSON b) => a -> b
applyContext = unsafeApply change
You can write more complicated transformations like Value -> Value with lens and lens-aeson. For example:
import Control.Lens
import Control.Monad.State
import Data.Aeson
import Data.Aeson.Lens
import Data.Text.Lens
import Data.Char
change :: Value -> Value
change = execState go
where
go = do
zoom values go
zoom members go
_String . _Text . each %= toUpper
_Bool %= not
_Number *= 10
main = print $ json & _Value %~ change
where json = "{\"a\":[1,\"foo\",false],\"b\":\"bar\",\"c\":{\"d\":5}}"
Output will be:
"{\"a\":[10,\"FOO\",true],\"b\":\"BAR\",\"c\":{\"d\":50}}"
Lets say I define a data type as follows:
data OP = Plus | Minus | Num Int deriving (Show, Eq)
Then I take a list of strings, and get a list of their respective OP values like this:
getOp :: [String] -> [OP]
getOp [] = []
getOp (x:rest)
| x == "+" = Plus:(getOp rest)
| isInfixOf "Num" x == True = Num (read (drop 4 x) :: Int):(getOp rest)
| otherwise = "-" = Minus:(getOp rest)
I then want to show the [OP] list, separated by new lines. I've done it with list of Strings easily, but not sure what to do with a list of data types.
I have the following structure as a starting point:
showOp :: [OP] -> String
showOp [] = []
showOp (o:os) = (putStr o):'\n':(showOp os)
I know the last line is wrong. I'm trying to return a [Char] in the first section, then a Char, then a recursive call. I tried some other variations for the last line (see below) with no luck.
showOp o = show o (works but not what I need. It shows the whole list, not each element on a new line
showOp o = putStrLn (show o) (epic fail)
showOp o
| o == "+" = "Plus\n":(showOp os)
| more of the same. Trying to return a [Char] instead of a Char, plus other issues.
Also, i'm not sure how the output will need to be different for the Num Int type, since I'll need to show the type name and the value.
An example i/o for this would be something like:
in:
getOp ["7","+","4","-","10"]
out:
Num 7
Plus
Num 4
Minus
Num 10
You need to look at the types of the functions and objects you are using. Hoogle is a great resource for getting function signatures.
For starters, the signature of putStr is
putStr :: String -> IO ()
but your code has putStr o, where o is not a string, and the result should not be an IO (). Do you really want showOp to print the Op, or just make a multi-line string for it?
If the former, you need the signature of showOp to reflect that:
showOp :: [Op] -> IO ()
Then you can use some do-notation to finish the function.
I'll write a solution for your given type signature. Since showOp should return a String and putStr returns an IO (), we won't be using putStr anywhere. Note that String is simply a type synonym for [Char], which is why we can treat Strings as a list.
showOp :: [Op] -> String
showOp [] = [] -- the empty list is a String
showOp (o:os) = showo ++ ('\n' : showos)
where showo = (show o) -- this is a String, i.e. [Char]
showos = showOp os -- this is also a String
Both showo and showos are Strings: both show and showOp return Strings.
We can add a single character to a list of characters using the cons operation :. We can append two lists of strings using append operator ++.
Now you might want another function
printOp :: [Op] -> IO ()
printOp xs = putStr $ showOp xs
How about:
showOp = putStrLn . unlines . map show
Note that your data constructor OP is already an instance of Show. Hence, you can actually map show into your array which contains members of type OP. After that, things become very somple.
A quick couple of notes ...
You might have wanted:
getOp :: [String] -> [OP]
getOp [] = []
getOp (x:rest)
| x == "+" = Plus:(getOp rest)
| x == "-" = Minus:(getOp rest)
| isInfixOf "Num" x == True = Num (read (drop 4 x) :: Int):(getOp rest)
| otherwise = (getOp rest)
Instead of what you have. Your program has a syntax error ...
Next, the input that you wanted to provide was probably
["Num 7","+","Num 4","-","Num 10"]
?. I guess that was a typo.
I'm still pretty new to Haskell and functional programming in general, so I'm writing a small program with Parsec to parse JSON and pretty print it as a means of learning basic concepts. This is what I have so far:
import Text.Parsec
import Text.Parsec.String
data JValue = JString String
| JNumber Double
| JBool Bool
| JNull
| JObject [(String, JValue)]
| JArray [JValue]
deriving (Eq, Ord, Show)
parseJString, parseJNumber, parseJBool, parseJNull :: Parser JValue
parseJString = do
str <- between (char '"') (char '"') (many (noneOf "\""))
return . JString $ str
parseJNumber = do
num <- many digit
return . JNumber . read $ num
parseJBool = do
val <- string "true" <|> string "false"
case val of
"true" -> return (JBool True)
"false" -> return (JBool False)
parseJNull = string "null" >> return JNull
parseJValue :: Parser JValue
parseJValue = parseJString
<|> parseJNumber
<|> parseJBool
<|> parseJNull
For now, I'm assuming that the numbers are integers. Individually, parseJString, parseJNumber, parseJBool, and parseJNull work as expected in ghci. Additionally, parseJValue correctly parses strings and numbers.
ghci> parse parseJString "test" "\"test input\""
Right (JString "test input")
ghci> parse parseJNumber "test" "345"
Right (JNumber 345.0)
ghci> parse parseJBool "test" "true"
Right (JBool True)
ghci> parse parseJNull "test" "null"
Right JNull
ghci> parse parseJValue "test" "\"jvalue test\""
Right (JString "jvalue test")
ghci> parse parseJValue "test" "789"
Right (JNumber 789.0)
parseJValue fails, however, when I try to parse true, false, or null, and I get an interesting error.
ghci> parse parseJValue "test" "true"
Right (JNumber *** Exception: Prelude.read: no parse
I get a successful parse, but the parse returns a JNumber followed by an error stating that Prelude.read failed. I feel like I'm missing some core concept in building my parsers, but I can't see where I've gone wrong. Also, am I making any beginner mistakes with my code, i.e. would any of this be considered "bad" haskell?
The problem is the usage of many in parseJNumber. It is also a valid parse, when no character of the following string is consumed ("many p applies the parser p zero or more times. [...]"). What you need is many1:
parseJNumber = do
num <- many1 (oneOf "0123456789")
return $ JNumber (read num :: Double)
Edit:
Somehow, I think your combination of (.) and ($) looks kind of weird. I use (.) when I can get rid of a function parameter (like in the usage of (>>=)) and ($) when I'm to lazy to write parentheses. In your function parseJString you do not need (.) in order to get the right binding precedences. (I did the same transformation in the code above.)
parseJString = do
str <- between (char '"') (char '"') (many (noneOf "\""))
return $ JString str
Additionally, you could eliminate code-repetition by refactoring parseJBool:
parseJBool = do
val <- string "true" <|> string "false"
return (case val of
"true" -> JBool True
"false" -> JBool False)
I would even rewrite the case-construct into a (total) local function:
parseJBool = (string "true" <|> string "false") >>= return . toJBool
where
-- there are only two possible strings to pattern match
toJBool "true" = JBool True
toJBool _ = JBool False
Last but not least, you can easily transform your other functions to use (>>=) instead of do-blocks.
-- additionally, you do not need an extra type signature for `read`
-- the constructor `JNumber` already infers the correct type
parseJNumber =
many1 (oneOf "0123456789") >>= return . JNumber . read
parseJString =
between (char '"') (char '"') (many (noneOf "\"")) >>= return . JString
You should try with many1 digit rather than many digit. A many succeeds on zero occurrences of the argument.
Compare:
ghci> parse (many digit) "test" "true"
Right ""
ghci> parse (many1 digit) "test" "true"
unexpected "t"
expecting digit
So in your case, parseJNumber within parseJValue will succeed and return an empty string which is then passed to read. But read "" :: Double fails.