Simple `Read` instance incorrectly `read`s - haskell

Why does this Read instance parse inconsistently?
import qualified Data.List as List
data Foo = Foo
instance Show Foo where
show _ = "Foo"
instance Read Foo where
readsPrec _ s = case List.stripPrefix "Foo" s of
Just rest -> [(Foo, rest)]
Nothing -> []
This is expected:
Test> reads "" :: [(Foo, String)]
[]
This is unexpected:
Test> read "" :: Foo
Foo
I would expect it to throw.

The problem isn't in read, but in show. Your show implementation doesn't force the input value of type Foo, because it returns "Foo" unconditionally, without even matching a constructor. If you use the derived Show instance, or write its equivalent by hand:
instance Show Foo where
show Foo = "Foo"
then you will get the expected error when you try to parse a malformed string, because evaluating show will actually require parsing the input string.

Related

Skipping certain items when parsing an array of json objects with Aeson

I am trying to write a FromJSON implementation which would parse a list of objects while at the same time skipping some of them - those which contain a certain json property.
I have the code like this, but without proper handling of mzero it returns an error once it encounters a value with "exclude: true".
newtype Response = Response [Foo]
newtype Foo = Foo Text
instance FromJSON Response where
parseJSON = withArray "Foos" $ \arr -> do
-- can I filter out here the ones which return `mzero`?
foos <- mapM parseJSON arr
pure $ Response (toList foos)
instance FromJSON Foo where
parseJSON = withObject "Foo" $ \foo -> do
isExcluded <- foo .: "exclude"
if isExcluded
then mzero
else do
pure $ Foo "bar"
I've found a few questions which hint at using parseMaybe, but I can't figure out how I can use it from within the FromJSON definition, it seems to be more suited to running the parser from "outside". Is it possible to do skipping "inside"? Or am I going the wrong route here?
What you're looking for is the optional function. It can be a bit tricky to find because it's very general-purpose and not simply a helper function in aeson. For your purposes, it will have the type Parser a -> Parser (Maybe a) and used in conjunction with catMaybes should do what you want.

Template Haskell: Generate Records

With Template Haskell I would like to generate records, eg:
data MyRecordA = MyRecordA
{fooA :: String, barA :: Bool}
The uppercase A in MyRecordA, fooA, barA and the type Bool of the second field should be variable and specified by the caller of the TH function.
I tried with several variations of:
{-# LANGUAGE TemplateHaskell #-}
module THRecord where
import Language.Haskell.TH
mkRecord :: Name -> Name -> Q [Dec]
mkRecord name cls = [d|
data $typeName :: $constName
{$fieldFoo, $fieldBar}
|]
where
typeName = conT $ "MyRecord" <> name
constrName = RecC $ "MyRecord" <> name
fieldFoo = sigP name ($clsString)
fieldBar = sigP name cls
clsString = conT "String"
Unfortunately, I get parse errors like
src/THRecord.hs:8:9: error: parse error on input ‘$fieldFoo’
There are several issues here; lets look at them one by one. The splice you have:
[d|
data $typeName :: $constName
{$fieldFoo, $fieldBar}
|]
is simply not valid; you may only splice entire expressions, types, or declarations, and not parts thereof. You also probably meant data $typeName = $constName but of course the same restriction applies to that, so it still won't work.
The definition
fieldFoo = sigP name ($clsString)
doesn't work because you may not have an splice of a local variable without an intervening quote. This is known as the 'stage restriction'.
fieldFoo = sigP name ($clsString)
fieldBar = sigP name cls
sigP is wrong because it constructs a pattern; you don't need to build any patterns (not sure what you meant here).
typeName = conT $ "MyRecord" <> name
constrName = RecC $ "MyRecord" <> name
clsString = conT "String"
All of these are trying to treat a Name as a String. If it isn't clear why that doesn't make sense, perhaps you should familiarize yourself with the basics of Haskell.
Now the solution:
import Data.Monoid
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
defBang = Bang NoSourceUnpackedness NoSourceStrictness
stringType = ConT ''String
mkRecord :: Name -> Name -> Q [Dec]
mkRecord name cls = (pure.pure)$
DataD [] typeName [] Nothing [constr] []
where
typeName = mkName $ "MyRecord" <> nameBase name
constr = RecC typeName [(mkName $ "foo" <> nameBase name, defBang, stringType)
,(mkName $ "bar" <> nameBase name, defBang, ConT cls)]
Note that you don't even make use of the Q monad here; not to generate names, nor to reify info about names. Therefore you can actually write a function Name -> Name -> Dec and then applying pure.pure to the result produces a type which can be spliced.
The above is for GHC 8.0.1; the AST of Template Haskell varies significantly between majour releases so it may not compile exactly as is on other versions.
Then e.g.
$(mkRecord (mkName "XYZ") ''Bool)
$(mkRecord (mkName "A") ''Int)
produces
data MyRecordXYZ = MyRecordXYZ {fooXYZ :: String, barXYZ :: Bool}
data MyRecordA = MyRecordA {fooA :: String, barA :: Int}
Finally, here is a solution which doesn't require TH. The family of types you wish to generate can be represented in a first class way:
import GHC.TypeLits
data MyRecord (nm :: Symbol) t = MyRecord { foo :: String, bar :: t }
type MyRecordA = MyRecord "A" Bool
type MyRecordXYZ = MyRecord "XYZ" Int

Haskell Type Polymorphism -- Mapping to String

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

a Show instance for undefined

Can anything be done to define a Show instance for an undefined value? Maybe some GHC extensions exist? I want something like this:
> print (1,undefined)
(1,"undefined")
According to the Haskell 2010 report, chapter 9, evaluating undefined should always cause an error:
-- It is expected that compilers will recognize this and insert error
-- messages that are more appropriate to the context in which undefined
-- appears.
undefined :: a
undefined = error "Prelude.undefined"
Since printing a value includes evaluating it, this will always give an error.
The bottom value (of which undefined is one flavor) is a value that is never constructed and hence can't be observed. This implies that you can't print it either. This value can't be compared to null from other languages, which usually can be observed and even checked against.
It is useful to think of undefined as well as error "blah" and all other bottoms as equivalent to results of infinite loops. The result of an infinite loop is never constructed and hence can't be observed.
More conceptually: The "undefined" is not a value like 'X'. The 'X' value has type Char. What type does "undefined" have? The symbol "undefined" is polymorphic, it can have any type (any type of kind *).
Type classes like "Show t" dispatch on the type t. So different type can and do have different show functions that display them. Which function gets your "undefined" depends on the type.
In GHCI most polymorphic types are defaulted to () so it can run the command. One can make a show function for a new type that does not look at the value:
Prelude> data Test = Test
Prelude> instance Show Test where show x = "I did not look at x"
Prelude> show Test
"I did not look at x"
Prelude> show (undefined :: Test)
"I did not look at x"
But as you can see this avoids the error with undefined by never examining the value at all. So this is a bit useless.
You could make your own type class and printing machinery that runs in IO and catches errors and does sort of what you want:
import Control.Exception
perr s = do x <- try (evaluate (show s)) :: IO (Either SomeException String)
return (either show id x))
The above translates errors into the error's string form:
Prelude Control.Exception> perr True
"True"
Prelude Control.Exception> perr (undefined :: Bool)
"Prelude.undefined"
Note: A better 'perr' needs to force the whole String instead of just the WHNF.
Even though (as the others already pointed out) you can't specify a Show instance for undefined, you may be able to put together a workaround by using catch as in the following code:
import qualified Control.Exception as C
import System.IO.Unsafe (unsafePerformIO)
showCatch :: (Show a) => a -> IO String
showCatch = showCatch' "undefined"
showCatch' :: (Show a) => String -> a -> IO String
showCatch' undef x = C.catch (C.evaluate (show x)) showUndefined
where
showUndefined :: C.ErrorCall -> IO String
showUndefined _ = return undef
unsafeShowCatch :: (Show a) => a -> String
unsafeShowCatch x = unsafePerformIO (showCatch x)
But this example will only work for simple expressions:
*Main> let v1 = showCatch 1
v1 :: IO String
*Main> let v2 = showCatch $ if True then undefined else 0
v2 :: IO String
*Main> v1
"1"
*Main> v2
"undefined"
*Main> let v3 = unsafeShowCatch 1
v3 :: String
*Main> let v4 = unsafeShowCatch $ undefined
v4 :: String
*Main> v3
"1"
*Main> v4
"undefined"
It won't work for calls like
showCatch (1,undefined)

Show for IO types

I have a data type which contains an IORef as an important element. This means there is not a clean way to make it a member of the show type class. This is not too bad as I have a print function in the IO monad for this type. But it is annoying in GHCi in that every time I return one of these thing as a result I get an error stating that it cannot be shown.
Is there a way to get GHCi, which operates in the IO monad anyway, to use an IO action to show a result? If not, would there be any negative consequences to writing show a = unsafePerformIO $ print a?
Have you considered adding to your .ghci file something like:
instance (Show a) => Show (IORef a) where
show a = show (unsafePerformIO (readIORef a))
It isn't safe at all, but if this is just for your personal use perhaps that is OK.
For more general use the previously given answers look good to me. That is, either define a static "I can't show this" message:
instance Show (IORef a) where
show _ = "<ioref>"
This would give something like:
> runFunc
MyStruct <ioref> 4 "string val"
Or use a custom function. I suggest making a class and lifting all the Show instances:
class ShowIO a where
showIO :: a -> IO String
instance Show a => ShowIO a where
showIO = return . show
instance ShowIO a => ShowIO (IORef a) where
showIO a = readIORef a >>= showIO
Giving the output (untested, this is just hand-written):
> myFunc >>= showIO
MyStruct "My String in an IORef" 4 "string val"
ghci has three cases for return values:
Show a => a: Just run show and print it
Show a => IO a: Execute the action, run show and print
IO (): print nothing
So usually, if you type an IO action, it get's executed and the result gets printed if it's not (). Let's try it:
ghci>15
15
ghci>'a' : 'b' : 'c' : []
"abc"
ghci>putStrLn "Hello, world!"
Hello, world!
ghci>putStrLn "Hello, world!" >> return 42
Hello, world!
42
ghci>
If you want to print something different, the best way is probably to write a custom function and stick it in front of each line you want to see:
myShowFun :: ... -> IO String
ghci> myShowFun $ ...
foobar

Resources