I have the unfortunate data to work with:
{ "name": "foo"
, "data": [ []
, ["a", "b", "c", 1]
, ["d", "e", "f", 2] ] }
The data entries are allowed to be either empty array, or an array of size four.
That I want to parse into:
data ResultRow = ResultRow Text Text Text Int deriving (Show, Generic)
data ResultSet =
ResultSet { f_name :: Text
, f_data :: [Maybe ResultRow] } deriving (Show, Generic)
The following however does not accept the empty arrays:
customOptions = defaultOptions { fieldLabelModifier = drop 2 }
instance FromJSON ResultRow where
parseJSON = genericParseJSON customOptions
instance FromJSON ResultSet where
parseJSON = genericParseJSON customOptions
The error message is:
Left "Error in $[1].data[0]: When expecting a product of 4 values, encountered an Array of 0 elements instead"
I've also tried putting an extra type around [Maybe ResultRow] and have that convert the sub-arrays to lists and pattern match on [], and dispatch the non-empty case to the ResultRow parser but I simply couldn't get it to compile and got lost in the error messages.
Ideally I would like to have some way of skipping the empty arrays as they're just noise in the data. I have no control of the producer of the data.
Like dsvensson, I'm puzzled that this doesn't 'just work' out of the box, since both [a] and Maybe a are FromJSON instances when a is. Since I already ended up spending way too much time on this, I can't offer an explanation, but I can offer a workaround. Hopefully someone more knowledgeable can give a better answer.
Instead of defining f_data as a [Maybe ResultRow], you can define a newtype that wraps Maybe ResultRow:
newtype MaybeResultRow = MaybeResultRow (Maybe ResultRow) deriving (Show, Generic)
You can give this type special FromJSON behaviour:
instance FromJSON MaybeResultRow where
parseJSON v =
case fromJSON v of
Success rr -> return $ MaybeResultRow $ Just rr
_ -> return $ MaybeResultRow Nothing
This, obviously, implies a change of ResultSet:
data ResultSet =
ResultSet { f_name :: Text
, f_data :: [MaybeResultRow] } deriving (Show, Generic)
In order to test, I defined this JSON document:
myJson :: ByteString
myJson =
"{\
\\"name\": \"foo\",\
\\"data\": [\
\[],\
\[\"a\", \"b\", \"c\", 1],\
\[\"d\", \"e\", \"f\", 2]\
\]\
\}"
Loading it all into GHCi, it looks like it's working:
*Lib Lib> decode myJson :: Maybe ResultSet
Just (ResultSet {
f_name = "foo"
, f_data = [
MaybeResultRow Nothing,
MaybeResultRow (Just (ResultRow "a" "b" "c" 1)),
MaybeResultRow (Just (ResultRow "d" "e" "f" 2))]})
Here, I've taken the liberty to format the output from GHCi in order to enhance readability.
I trust that you can figure out how to unwrap and filter the list of MaybeResultRow values...
I stole the solution of using fromJSON and matching on Success from this answer.
Related
I'm trying to build a CLI food journal app.
And this is the data type I want the user input to be parsed in.
data JournalCommand =
JournalSearch Query DataTypes Ingridents BrandOwnder PageNumber
| JournalReport Query DataTypes Ingridents BrandOwnder PageNumber ResultNumber
| JournalDisplay FromDate ToDate ResultNumber
| JournalStoreSearch Query DataTypes Ingridents BrandOwnder PageNumber ResultNumber StoreFlag
| JournalStoreCustom CustomEntry OnDate StoreFlag
| JournalDelete FromDate ToDate ResultNumber
| JournalEdit CustomEntry ResultNumber
deriving (Show, Eq)
and because there's a lot of overlap I have a total of 8 functions with Parser a type.
Functions like these
-- | Search Query
aQueryParser :: Parser String
aQueryParser = strOption
( long "search"
<> short 's'
<> help "Search for a term in the database"
)
The idea if to ultimately have a function like this
runJournal :: JournalCommand -> MT SomeError IO ()
runJournal = \case
JournalSearch q d i b p
-> runSearch q d i b p
JournalReport q d i b p r
-> runSearchAndReport q d i b p r
...
...
where MT is some monad transformer that can handle error + IO. Not sure yet.
The question is: How do I setup the parseArgs function
parseArgs :: IO JournalCommand
parseArgs = execParser ...
and parser function
parser :: Parser JournalCommand
parser = ...
so that I'd be able to parse user input into JournalCommand and then return the data to relevant functions.
I know I can fmap a data type like this
data JournalDisplay { jdFromDate :: UTCTime
, jdToDate :: UTCTime
, jdResultNumber :: Maybe Int
}
as
JournalDisplay
<$>
fromDateParser
<*>
toDateParser
<*>
optional resultNumberParser
But I'm not sure how to go about doing that with my original data structure.
I think I need to have a list like this [Mod CommandFields JournalCommand] which I may be able to pass into subparser function by concatenating the Mod list. I'm not completely sure.
In optparse-applicative there's the Parser type, but also the ParserInfo type which represents a "completed" parser holding extra information like header, footer, description, etc... and which is ready to be run with execParser.
We go from Parser to ParserInfo by way of the info function which adds the extra information as modifiers.
Now, when writing a parser with subcommands, each subcommand must have its own ParserInfo value (implying that it can have its own local help and description).
We pass each of these ParserInfo values to the command function (along with the name we want the subcommand to have) and then we combine the [Mod CommandFields JournalCommand] list using mconcat and pass the result to subparser. This will give us the top-level Parser. We need to use info again to provide the top-level description and get the final ParserInfo.
An example that uses a simplified version of your type:
data JournalCommand =
JournalSearch String String
| JournalReport String
deriving (Show, Eq)
journalParserInfo :: O.ParserInfo JournalCommand
journalParserInfo =
let searchParserInfo :: O.ParserInfo JournalCommand
searchParserInfo =
O.info
(JournalSearch
<$> strArgument (metavar "ARG1" <> help "This is arg 1")
<*> strArgument (metavar "ARG2" <> help "This is arg 2"))
(O.fullDesc <> O.progDesc "desc 1")
reportParserInfo :: O.ParserInfo JournalCommand
reportParserInfo =
O.info
(JournalReport
<$> strArgument (metavar "ARG3" <> help "This is arg 3"))
(O.fullDesc <> O.progDesc "desc 2")
toplevel :: O.Parser JournalCommand
toplevel = O.subparser (mconcat [
command "search" searchParserInfo,
command "journal" reportParserInfo
])
in O.info toplevel (O.fullDesc <> O.progDesc "toplevel desc")
I am new to Haskell, so maybe I am missing some fundamental concepts here (or maybe failed to find the appropriate extension). I was wondering if there was a way to optimize or further abstract the following scenario. This code seems very redundant.
Let's say I have the following data classes:
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
Let's say I have a service and I'm only concerned with outputing records as strings. In reality, the strings will probably be JSON and the records fetched from the DB, but let's take a simpler case. I basically need a URL token to fetch an appropriate object (say, the string "dog" will get me a Dog, or even just the Haskell "show" string, without expressly declaring it as (value)::Dog).
I have attempted to implement this in several ways...the only thing that seems to work is the following:
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
I'm not entirely fond of the new type, nor the list of fromString declarations. And to benefit from the original data declarations, I would probably need to write a similarly tedious expression (eg, "fromCreature") to revert Creature back into my original types. This information might change, so I would probably need TH for a few of the declarations...
Is there a way around some of this? I fiddled with GADTs and classes, but both seemed to be dependent on type- rather than value- based polymorphism (A string identifier tends to cause issues with ambiguous instances). It would be nice to map the constructor to a string (Say, with Data.Map), but constructors often have different kinds.
Update
So, I went with an approach that isn't exactly relevant to the question I had asked, but it may be useful to someone. I did want to maintain some record types, but most didn't add much value and were getting in my way. The steps I had followed went something like:
Use a different/lower-level DB driver, that returns workable types (eg, [ColumnDef] and [[SQLValue]] instead of tuples and records...).
Create ToJSON instances for SQLValue -- most of the types were covered, except a few ByteString types, and I had to handle the conversion of SQLNull to Null. To maintain compatibility with some record types, my default handler looked like: toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue} The untagged value should allow one to read the JSON into defined data types (eg, Dog / Person ) if desired....
Given that column name is accessible from ColumnDef, I wrote an expression that zips [ColumnDef] and [SqlValue] to a list of Aeson-compatible key-value pairs, eg: toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
Then, I wrote an expression to fetch the JSON from a table name, which more or less serves as my "universal dispatcher." It references a list of authorized tables, so it's less crazy than it might sound.
The code looked a bit like this (using mysql-haskell).
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
If what you want to consume at the end is json value - it might make sense to
represent result as json value using aeson library:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
High energy magic version
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement
I'm working with some complexly formatted JSON responses from a REST server. To decode them, I have a couple of data types to handle the different nested objects. For example:
... Other types ...
data Profile =
Profile { fields :: [KVPair]
} deriving (Show)
instance FromJSON Profile where
parseJSON (Object v) =
Profile <$> v .: "Fields"
parseJSON _ = mzero
data KVPair =
KVPair { key :: Int
, value :: String
} deriving (Show)
instance FromJSON KVPair where
parseJSON (Object v) =
KVPair <$> v .: "Key"
<*> v .: "Value"
parseJSON _ = mzero
Everything works except for the final KVPair type. My JSON objects all have integer keys; however, the values can be either an integer or a string:
{
"Key": 0,
"Value": "String Value!"
},
{
"Key": 1,
"Value": 42
}
Now I suppose I could add another sum type to my value decode that is composed of String and Int, but I would prefer to avoid adding a whole new type just for that. Does Aeson have a simple way to handle this scenario?
There are two simple fixes. One is to simply write
data KVPair = KVPair { key :: Int, value :: Value }
and leave all other code the same. Consumers will need to check the Value to see whether it is a string-y thing or a number-y thing.
Probably the better way is to simply provide two alternative parsers that both convert to your desired format. For example, keeping your KVPair definition as is, one might write
showInt :: Int -> String
showInt = show
instance FromJSON KVPair where
parseJSON (Object v)
= KVPair
<$> v .: "Key"
<*> (v .: "Value" <|> (showInt <$> v .: "Value"))
The best of both worlds would be to keep the information about whether it's a String or Int around and to reject other kinds of values; e.g.
data KVPair = KVPair { key :: Int, value :: Either String Int }
instance FromJSON KVPair where
parseJSON (Object v)
= KVPair
<$> v .: "Key"
<*> ( (Left <$> v .: "Value")
<|> (Right <$> v .: "Value")
)
You'll just have to use the Aeson Value type to work with an Object with fields that can be any JSON value.
I have a data type where one of the fields is a list of one of n other data types (n is small and the types are known in advance). I would like to make a JSON parser but I can't quite figure it out. I've tried creating a Pet type class and making them both instances of it, but it seemed to be a dead end. Any help would be appreciated!
As a simplified example - I have a Person data type who can have a list of pets, either dogs or cats - but not a mix of both.
Here's the example:
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Data.Aeson
import Data.ByteString.Lazy as L
import Data.Aeson.Types (Parser)
import Control.Monad (mzero)
data Person = Person {
name :: String,
species :: String,
pets :: [?] -- a list of dogs OR cats
} deriving Show
instance FromJSON (Person a) where
parseJSON (Object v) = ???
data Dog = Dog {
dogField :: String
} deriving Show
instance FromJSON Dog where
parseJSON (Object v) = Dog <$>
v .: "dogField"
data Cat = Cat {
catField :: String
} deriving Show
instance FromJSON Cat where
parseJSON (Object v) = Cat <$>
v .: "catField"
A standard way of representing either one type or another is to use the Either type, e.g.:
data Person { ..., pets :: Either [Dog] [Cat] }
Also, you might be interested in use GHC Generics to auto-derive the To/FromJSON instances.
An example with a data structure that uses Either:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Person = Person {
name :: String,
species :: String,
pets :: Either [String] [Int]
} deriving (Show,Generic)
instance ToJSON Person -- instances are auto-derived
instance FromJSON Person
doit = do
let me = Person "user5402" "Human" (Right [42])
print $ encode me
If you have more than two alternatives you can easily create your own sum type like this:
-- assume the possible pet types are: Dog, Cat, Rodent, Reptile
data Pets = Dogs [Dog] | Cats [Cat] | Rodents [Rodent] | Reptiles [Reptile]
deriving (Show, Generic)
data Person { ..., pets :: Pets }
deriving (Show, Generic)
doit = do
let me = Person "user5402" "Human" (Rodents [agerbil, amouse])
print $ encode me
where agerbil and amouse are Rodent values.
I'm modifying #user5402's answer because I don't like the "tag" and "contents" fields that Generics added. Also accepting his answer since he gave me the key insight of how to structure the sum type
instance FromJSON Pets where
parseJSON (Object o) = (parsePets o "pets")
parseJSON _ = mzero
parsePets :: Object -> T.Text -> Parser Pets
parsePets o key = case H.lookup key o of
Nothing -> fail $ "key " ++ show key ++ " not present"
Just v -> parseToCatsOrDogs (o .: "species") v
{-# INLINE parsePets #-}
parseToCatsOrDogs :: Parser String -> Value -> Parser Pets
parseToCatsOrDogs speciesParser (Array v) = speciesParser >>= \species -> case species of
"dog" -> (V.mapM (\x -> parseJSON $ x) v) >>= \ dogVector -> return $ Dogs (V.toList dogVector)
"cat" -> (V.mapM (\x -> parseJSON $ x) v) >>= \ catVector -> return $ Cats (V.toList catVector)
_ -> mzero
parseToCatsOrDogs _ _ = mzero
Today I wanted to solve next problem.
Assume that we have typeclass DataWithDefault defined as
class DataWithDefault a where
defaultValue :: a
And we have data Example defined as
data Example =
Example { field1 :: Text
, field2 :: Text
} deriving (Show)
instance DataWithDefault Example where
defaultValue = Example "Hello" "World"
instance FromJSON Example where
parseJSON (Object v) =
Example <$> v .:? "field1" .!= field1 defaultValue
<*> v .:? "field2" .!= field2 defaultValue
parseJSON _ = mzero
instance ToJSON Example where
toJSON (Example f1 f2) =
object [ "field1" .= f1
, "field2" .= f2
]
I know that Aeson uses Generics to derive FromJSON and ToJSON instances automatically, but I can't figure out how to make it derive FromJSON instance with default values for fields that are not represented in given json. Is it possible to do using generics? Actually I don't ask you a final solution, but maybe some clue?
Update
Let me add more information about the problem.
Suppose now that you need to update your Example data and now it defined as
data Example =
Example { field1 :: Text
, field2 :: Text
, field3 :: Int
} deriving (Show)
So you want to update DataWithDefault instance declaration
instance DataWithDefault Example where
defaultValue = Example "Hello" "World" 12
And what I want to do is not to write
instance FromJSON Example where
parseJSON (Object v) =
Example <$> v .:? "field1" .!= field1 defaultValue
<*> v .:? "field2" .!= field2 defaultValue
<*> v .:? "field3" .!= field3 defaultValue
parseJSON _ = mzero
And want to derive such instance definition automatically. And more importantly, I want to do it not only for Example, but for DataWithDefault a.
Update 2
The point of combining .:? and .!= is to get as much as possible fields from given json and set every missing field to it's default value. So when we pass
{ "field1" : "space", "field2" : "ship" }
I want my new example be not field1 = Hello; field2 = World; field3 = 12, but field1 = space; field2 = ship; field3 = 12.
Instead of making Aeson do it, just use a newtype for what they were designed for:
newtype DefaultJSON a = DefaultJSON { unDefaultJSON :: a }
instance (FromJSON a, DataWithDefault a) => FromJSON (DefaultJSON a) where
parseJSON v = DefaultJSON <$> (parseJSON v <|> pure defaultValue)
Then you can do
> decode "{}" :: Maybe (DefaultJSON Example)
Just (DefaultJSON {unDefaultJSON = (Example {field1 = "Hello", field2 = "World"}})
This is a little different than what you asked, it provides a default value in case parsing fails, but not a default value for each field in case that individual field is missing.