So I have a file where the first line has the format ([String], [(Int, Int)], [(Int, Int)], Int) and the rest of the lines have the format [((Int, Int), (Int, Int), String)]. I managed to get the the input and parse it with the following function:
someFunction :: String -> IO (String)
someFunction fileName = do
handle <- openFile fileName ReadMode
contents <- hGetLine handle
let firstLine = read contents :: ([String], [(Int, Int)], [(Int, Int)], Int)
restOfLines <- map read <$> lines <$> hGetContents handle :: IO [((Int, Int), (Int, Int), String)]
...
The thing is, that I want to print a custom error if the file has the wrong format. So if something is missing or what not, it should only print "some error". Otherwise, the lines have to be parsed so I can do some other things with the content. I would appreciate it if someone could help me with this.
The simplest way to detect whether a Read parser failed is to use readMaybe. E.g. in GHCi:
> import Text.Read (readMaybe)
> :t readMaybe
readMaybe :: Read a => String -> Maybe a -- Defined in ‘Text.Read’
> readMaybe "1" :: Maybe Int
Just 1
> readMaybe ":(" :: Maybe Int
Nothing
You can pattern-match on the result of readMaybe with case like any other use of Maybe:
case readMaybe input of
Just parsed -> … -- Use parsed value
Nothing -> … -- Report error
This can only report a generic failure; for more complex parsing and validation, you should use a proper parsing library. One included with base is Text.ParserCombinators.ReadP:
import Control.Applicative (some)
import Data.Char (isDigit)
import Text.ParserCombinators.ReadP (ReadP)
import qualified Text.ParserCombinators.ReadP as ReadP
-- Parse one or more digits.
number :: ReadP Int
number = read <$> some (ReadP.satisfy isDigit)
These parsers can be executed on some input with readP_to_S; by default they enumerate all possible parses, which you can constrain with functions like eof (require complete input) or <++ (biased choice).
> import Text.ParserCombinators.ReadP (readP_to_S)
> readP_to_S number "123"
[(1,"23"),(12,"3"),(123,"")]
> readP_to_S (number <* ReadP.eof) "123"
[(123,"")]
You can pattern-match on the resulting list to validate, for example, that there’s only one result and extract what you want or report the error. Another popular choice of parsing library is the megaparsec package, which can additionally provide nice custom error messages with source locations.
I don't know how to check type of variable in haskell, Here i mean , when i read something from console with getLine ,however i expect it to be an interger but user can enter a string also,then i don't want my program to crash. For example if someone inputs a string and i try to convert it to Int then it will crash(exception) so i want to check whether it is convertable or not. How do i do that ? Thanks for any help :)
main1 = do
let g <- getLine
k = g :: Int
if(k :: Int)
then ........
EDIT: Notice you always have a string from getLine - that's the type it returns. If that string contains an ascii representation of a number then great and keep reading.
If you have a string, g, and say g :: Int the compiler will simply so "no, you are wrong, that's a String". You need to perform a translation - parse the string and compute an Int. The most readily available methods are read in the Prelude and readMaybe in Text.Read.
Read will work but throws exceptions on invalid input:
Prelude> read "4742" :: Int
4742
Prelude> read "no" :: Int
*** Exception: Prelude.read: no parse
Prelude> read "191andmore"
*** Exception: Prelude.read: no parse
The maybe variant is exception safe:
Prelude> import Text.Read
Prelude Text.Read> readMaybe "181" :: Maybe Int
Just 181
Prelude Text.Read> readMaybe "no" :: Maybe Int
Nothing
Prelude Text.Read> readMaybe "211andmore" :: Maybe Int
Nothing
I have a little toy semantics for natural language, with words like:
ran :: String -> Bool
ran = (`elem` ["Bart", "Homer", "Marge"])
and:
bart :: String
bart = "Bart"
So for example, I can have (ran bart) :: Bool, and so on.
I want to write a parser which, for example takes the string "Bart ran" and returns True. I'd probably use Parsec for this.
However, the problem is being able to call functions via strings. E.g. getting from "ran" to the function ran. For this, I thought Language.Haskell.Interpreter's interpret function might be appropriate.
So my questions are:
Is this a sensible way to do what I want to do?
If so, why doesn't the following work, entered into GHCi, given a module called Grammar.hs in the same directory with ran defined as above:
let a = runInterpreter $ do
loadModules ["Grammar"]
setImports ["Prelude"]
interpret "ran" (as :: String -> Bool)
let b = do
x <- a
return $ x <*> pure "John"
b
I get the error:
"Left (WontCompile [GhcError {errMsg = "<interactive>:2:1:\n Not in scope: \8216ran\8217\n Perhaps you meant \8216tan\8217 (imported from Prelude)"}])"
which suggests that the import isn't working, and indeed, if I try something similar with a Prelude function, everything works.
Why do I get the following type error (among many others) if I try to compile the same code as in Q2, (minus the let):
No instance for MonadIO m0 arising from a use of runInterpreter
As for #2, you need to add "Grammar" to the setImports list as well:
runInterpreter $ do
loadModules ["HintDefs"]
setImports ["Prelude", "HintDefs"]
interpret "ran" (as :: String -> Bool)
As for #3, it is because runInterpreter is monomorphic in the choice of monad to run it in:
runInterpreter :: (MonadIO m, MonadMask m)
=> InterpreterT m a
-> m (Either InterpreterError a)
So you'll need to choose a particular m by running it in e.g. IO:
main :: IO ()
main = do
ran <- runInterpreter $ do
loadModules ["HintDefs"]
setImports ["Prelude", "HintDefs"]
interpret "ran" (as :: String -> Bool)
print $ ran <*> pure "John"
Now, as for #1, I am not convinced you need something as stupidly powerful as HInt here. You could just maintain a dictionary of String -> Bool functions keyed by a String key, something simple like a Map String (String -> Bool), and then use that to look up ran etc.
I'm trying to get a number from IO like this:
numberString <- getLine
print 3 + read numberString
This works if numberString is a good string of number (like "3241"), but when it's not something that good (like "124gjh"), it throws an exception:
*** Exception: Prelude.read: no parse
There's a reads function which returns a [(a0, String)] and when nothing is matched this would be a []. Is there an easy way that I have something like this:
read' :: String -> Maybe a
so that I just get a Nothing if things doesn't work instead of just stopping abruptly?
There is readMaybe right in Text.Read which should do exactly what you asked for:
Prelude> import Text.Read(readMaybe)
Prelude Text.Read> readMaybe "3241" :: Maybe Int
Just 3241
Prelude Text.Read> readMaybe "Hello" :: Maybe Int
Nothing
I have a question. There is any solution for reading from file list of tuples ? Depends on content ?
I know that if i need to read integers i do something like that:
toTuple :: [String] -> [(Int,Int)]
toTuple = map (\y -> read y ::(Int,Int))
But in file i can have tuples this kind (int,int) or (char, int). Is any way to do this nice ?
I was trying to do this at first in finding sign " ' " . If it was, then reading chars, but it doesn't work for some reason.
[Edit]
To function to tuple, i give strings with tuples, before that i splits lines by space sign.
INPUT EXAMPLE:
Case 1 : ["(1,2)", "(1,3)" ,"(3,4)" ,"(1,4)"]
Case 2 : ["('a',2)", "('b',3)", "('g',8)", "('h',2)", "('r',4)"]
Just try both and choose the successful:
import Text.Read
import Control.Applicative
choose :: Maybe a -> Maybe b -> Maybe (Either a b)
choose x y = fmap Left x <|> fmap Right y
readListMaybe :: Read a => [String] -> Maybe [a]
readListMaybe = mapM readMaybe
toTuple :: [String] -> Maybe (Either [(Int, Int)] [(Char, Int)])
toTuple ss = readListMaybe ss `choose` readListMaybe ss
main = do
-- Just (Left [(1,2),(1,3),(3,4),(1,4)])
print $ toTuple ["(1,2)", "(1,3)" ,"(3,4)" ,"(1,4)"]
-- Just (Right [('a',2),('b',3),('g',8),('h',2),('r',4)])
print $ toTuple ["('a',2)", "('b',3)", "('g',8)", "('h',2)", "('r',4)"]
Here is a far more efficient (and unsafe) version:
readListWithMaybe :: Read a => String -> [String] -> Maybe [a]
readListWithMaybe s ss = fmap (: map read ss) (readMaybe s)
toTuple :: [String] -> Either [(Int, Int)] [(Char, Int)]
toTuple [] = Left []
toTuple (s:ss) = fromJust $ readListWithMaybe s ss `choose` readListWithMaybe s ss
In the first definition of toTuple
toTuple :: [String] -> Maybe (Either [(Int, Int)] [(Char, Int)])
toTuple ss = readListMaybe ss `choose` readListMaybe ss
readListMaybe is too strict:
readListMaybe :: Read a => [String] -> Maybe [a]
readListMaybe = mapM readMaybe
mapM is defined in terms of sequence which is defined in terms of (>>=) which is strict for the Maybe monad. And also the reference to ss is keeped for too long. The second version doesn't have these problems.
As I said it may be a good idea to consider using a parsing library, if the task at hand gets a bit more complicated.
First of all you have the benefit of getting error messages and if you decide to switch to a self declared data Type it is still easily applicable (with slight modifications of course).
Also switching from ByteString to Text (which are both preferable to working with String anyways) is just a matter of (un)commenting 4 lines
Here is some example if you have not had the pleasure to work with it.
I'll explain it some time later today - for I have to leave now.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Char8 as X
-- import Data.Attoparsec.Text
-- import Data.Text as X
main :: IO ()
main = do print <$> toTuples $ X.unlines ["(1,2)","(1,3)","(3,4)","(1,4)"]
print <$> toTuples $ X.unlines ["('a',2)","('h',2)","('r',4)"]
print <$> toTuples $ X.unlines ["('a',2)","(1,3)","(1,4)"] --works
print <$> toTuples $ "('a',2)" -- yields Right [Right ('a',2)]!!
print <$> toTuples $ "(\"a\",2)" -- yields Right []!!
toTuples = parseOnly (myparser `sepBy` skipSpace :: Parser [Either (Int,Int) (Char,Int)])
where myparser :: Parser (Either (Int,Int) (Char,Int))
myparser = eitherP (tupleP decimal decimal)
(tupleP charP decimal)
charP = do char '\''
c <- notChar '\''
char '\''
return c
tupleP :: Parser a -> Parser b -> Parser (a, b)
tupleP a b = do char '('
a' <- a
skipSpace
char ','
skipSpace
b' <- b
char ')'
return (a',b')
Edit: Explanation
Parser is a monad, so it comes with do-notation which enables us to write the tupleP function in this very convenient form. Same goes for charP - we describe what to parse in the primitives given by the attoparsec library
and it reads something like
first expect a quote
then something that is not allowed to be a quote
and another quote
return the not quote thingy
if you can write down the parser informally you're most likely halfway through writing the haskell code, the only thing left to do is find the primitives in the library or write some auxilary function like tupleP.
A nice thing is that Parsers (being monads) compose nicely so we get our desired parser eitherP (tupleP ..) (tupleP ..).
The only magic that happens in the print <$>.. lines is that Either is a functor and every function using <$> or fmap uses the Right side of the Eithers.
Last thing to note is sepBy returns a list - so in the case where the parsing fails we still get an empty list as a result, if you want to see the failing use sepBy1 instead!