I'm having trouble figuring how to wrap a StateT with an ExceptT (I'm pretty new to Haskell). I have this (incomplete, working) code:
-- Initialise the computer and run the program
runProgram pr dv = do
let comp = Computer { program = pr
, dataVals = dv
, acc = 0
, pc = 0
, halted = False
}
evalStateT execute comp
-- Main execution "loop"
execute :: StateT Computer IO ()
execute = do
output <- step
liftIO $ putStr output
comp <- get
if halted comp
then return ()
else execute
-- Execute a single step/cycle
step :: Monad m => StateT Computer m String
step = do
comp <- get
-- TODO handle out of range PC and other errors here?
let Instruction lineNo opCode operand = program comp !! pc comp
-- TODO add rest of instructions
case opCode of
HALT -> do
put $ comp{ halted = True }
return "HALT\n"
LINE -> do
let comp' = comp{ pc = pc comp + 1 }
put comp'
return "\n"
PRINT -> do
let comp' = comp{ pc = pc comp + 1 }
put comp'
let TextOperand s = operand
return s
_ -> do
let comp' = comp{ pc = pc comp + 1 }
put comp'
return $ "step: PC = " ++ (show $ pc comp') ++ "\n"
I'd like to add some error handling to step (see "TODO" comment) so I figured that wrapping the StateT in an ExceptT would allow me to do some checks which return an error status instead of continuing if something's wrong (like PC being out of range). However, I can't figure out how - I've tried lots of combinations but none work.
This is my code
module Main where
import Control.Monad (mapM)
import Text.Read (readMaybe)
import System.IO (BufferMode(..), stdout, hSetBuffering)
mouth = [('P',0),('(',1),('[',2),(')',3),('O',4)]
eyes = [(':',1),('8',2),(';',3)]
findKey :: (Eq k) => k -> [(k,v)] -> Maybe v
findKey key = foldr (\(k,v) acc -> if key == k then Just v else acc) Nothing
query :: Read a => String -> IO a
query prompt = do
putStr $ prompt ++ ": "
val <- readMaybe <$> getLine
case val of
Nothing -> do
putStrLn "Sorry that's a wrong value - please reenter"
query prompt
Just v -> return v
ngoers :: IO Int
ngoers = query "Enter the number of Concertgoers"
cgoers :: Int -> IO (Int, Double)
cgoers i = do
c <- query prompt
return (fromIntegral i,c)
where prompt = "Enter the emoticon for concertgoer " ++ show (i+1)
concertgoer :: IO [(Int, Double)]
concertgoer = do
n <- ngoers
mapM cgoers [0,1..n-1]
presentResult :: Double -> IO ()
presentResult v = putStrLn $ "The results are: " ++ show v
main :: IO ()
main = do
p <- concertgoer
presentResult $ 0
I want this output
Enter the number of Concertgoers: 4
Enter the emoticon for concertgoer 1: :(
Enter the emoticon for concertgoer 2: :)
Enter the emoticon for concertgoer 3: ;P
Enter the emoticon for concertgoer 4: ;o
The results are: 2 4 3 7
From your example I'm guessing that you match each eye and mouth to a number, and a emoticon is the sum if those... but you haven't explained nothing of this in your post. Assuming so, this is a very naive way to write It
import Control.Monad (mapM)
-- Define the data you want to use
data Eye = Normal
| Glasses
| Wink
deriving(Show, Eq)
data Mouth = P
| Sad
| Bracket
| Happy
| O
deriving(Show, Eq)
data Face = Face Eye Mouth deriving(Show, Eq)
-- Define special readers and elemToInt
readEyes :: Char -> Maybe Eye
readEyes c = case c of
':' -> Just Normal
'8' -> Just Glasses
';' -> Just Wink
_ -> Nothing
-- This is equivalent to derive Enum class and apply fromEnum. Try to do it your self ;)
eyeToInt :: Eye -> Int
eyeToInt Normal = 1
eyeToInt Glasses = 2
eyeToInt Wink = 3
readMouth :: Char -> Maybe Mouth
readMouth c = case c of
'P' -> Just P
'(' -> Just Sad
'[' -> Just Bracket
')' -> Just Happy
'O' -> Just O
_ -> Nothing
mouthToInt :: Mouth -> Int
mouthToInt P = 0
mouthToInt Sad = 1
mouthToInt Bracket = 2
mouthToInt Happy = 3
mouthToInt O = 4
readFace :: String -> Maybe Face
readFace [] = Nothing
readFace [e,m] = do
eye <- readEyes e
mouth <- readMouth m
return $ Face eye mouth
readFace _ = Nothing
faceToInt :: Face -> Int
faceToInt (Face e m) = eyeToInt e + mouthToInt m
-- The main loop is straight forward
main :: IO ()
main = do
putStrLn "Enter the number of Concertgoers"
number <- read <$> getLine -- Use safe reading better... I am using an online repl so no access to it
results <- mapM getEmoticon [1..number]
putStrLn $ "The results are: " ++ show results
where getEmoticon n = do
putStrLn $ "Enter the emoticon for concertgoer " ++ show n
face <- readFace <$> getLine
case face of
Nothing -> do
putStrLn "That's not an emotion!!"
getEmoticon n
Just f -> return $ faceToInt f
I think It is what you expect but let me know
This question already has answers here:
How to get normal value from IO action in Haskell
(2 answers)
Closed 7 years ago.
I just started learning Haskell and got my first project working today. Its a small program that uses Network.HTTP.Conduit and Graphics.Rendering.Chart (haskell-chart) to plot the amount of google search results for a specific question with a changing number in it.
My problem is that simple-http from the conduit package returns a monad (I hope I understood the concept of monads right...), but I only want to use the ByteString inside of it, that contains the html-code of the website. So until now i use download = unsafePerformIO $ simpleHttp url to use it later without caring about the monad - I guess that's not the best way to do that.
So: Is there any better solution so that I don't have to carry the monad with me the whole evaluation? Or would it be better to leave it the way the result is returned (with the monad)?
Here's the full program - the mentioned line is in getResultCounter. If things are coded not-so-well and could be done way better, please remark that too:
import System.IO.Unsafe
import Network.HTTP.Conduit (simpleHttp)
import qualified Data.ByteString.Lazy.Char8 as L
import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Backend.Cairo
numchars :: [Char]
numchars = "1234567890"
isNum :: Char -> Bool
isNum = (\x -> x `elem` numchars)
main = do
putStrLn "Please input your Search (The first 'X' is going to be replaced): "
search <- getLine
putStrLn "X ranges from: "
from <- getLine
putStrLn "To: "
to <- getLine
putStrLn "In steps of (Only whole numbers are accepted):"
step <- getLine
putStrLn "Please have some patience..."
let range = [read from,(read from + read step)..read to] :: [Int]
let searches = map (replaceX search) range
let res = map getResultCounter searches
plotList search ([(zip range res)] :: [[(Int,Integer)]])
putStrLn "Done."
-- Creates a plot from the given data
plotList name dat = toFile def (name++".png") $ do
layout_title .= name
plot (line "Results" dat)
-- Calls the Google-site and returns the number of results
getResultCounter :: String -> Integer
getResultCounter search = read $ filter isNum $ L.unpack parse :: Integer
where url = "http://www.google.de/search?q=" ++ search
download = unsafePerformIO $ simpleHttp url -- Not good
parse = takeByteStringUntil "<"
$ dropByteStringUntil "id=\"resultStats\">" download
-- Drops a ByteString until the desired String is found
dropByteStringUntil :: String -> L.ByteString -> L.ByteString
dropByteStringUntil str cont = helper str cont 0
where helper s bs n | (bs == L.empty) = L.empty
| (n >= length s) = bs
| ((s !! n) == L.head bs) = helper s (L.tail bs) (n+1)
| ((s !! n) /= L.head bs) = helper s (L.tail bs) 0
-- Takes a ByteString until the desired String is found
takeByteStringUntil :: String -> L.ByteString -> L.ByteString
takeByteStringUntil str cont = helper str cont 0
where helper s bs n | bs == L.empty = bs
| n >= length s = L.empty
| s !! n == L.head bs = L.head bs `L.cons`
helper s (L.tail bs) (n + 1)
| s !! n /= L.head bs = L.head bs `L.cons`
helper s (L.tail bs) 0
-- Replaces the first 'X' in a string with the show value of the given value
replaceX :: (Show a) => String -> a -> String
replaceX str x | str == "" = ""
| head str == 'X' = show x ++ tail str
| otherwise = head str : replaceX (tail str) x
This is a lie:
getResultCounter :: String -> Integer
The type signature above is promising that the resulting integer only depends on the input string, when this is not the case: Google can add/remove results from one call to the other, affecting the output.
Making the type more honest, we get
getResultCounter :: String -> IO Integer
This honestly admits it's going to interact with the external world. The code then is easily adapted to:
getResultCounter search = do
let url = "http://www.google.de/search?q=" ++ search
download <- simpleHttp url -- perform IO here
let parse = takeByteStringUntil "<"
$ dropByteStringUntil "id=\"resultStats\">" download
return (read $ filter isNum $ L.unpack parse :: Integer)
Above, I tried to preserve the original structure of the code.
Now, in main we can no longer do
let res = map getResultCounter searches
but we can do
res <- mapM getResultCounter searches
after importing Control.Monad.
Im working through the exercises on wikibooks/haskell and there is an exercise in the MonadPlus-chapter that wants you to write this hexChar function. My function works as shown below, but the thing is that when I try to switch the 2 helper parsers (digitParse and alphaParse) around the function ceases to work properly. If I switch them around I can only parse digits and not alphabetic chars anymore.
Why is this so?
char :: Char -> String -> Maybe (Char, String)
char c s = do
let (c':s') = s
if c == c' then Just (c, s') else Nothing
digit :: Int -> String -> Maybe Int
digit i s | i > 9 || i < 0 = Nothing
| otherwise = do
let (c:_) = s
if read [c] == i then Just i else Nothing
hexChar :: String -> Maybe (Char, String)
hexChar s = alphaParse s `mplus` digitParse s -- cannot switch these to parsers around!!
where alphaParse s = msum $ map ($ s) (map char (['a'..'f'] ++ ['A'..'F']))
digitParse s = do let (c':s') = s
x <- msum $ map ($ s) (map digit [0..9])
return (intToDigit x, s')
if read [c] == i then Just i else Nothing
The marked code has a flaw. You're using Int's Read instance, e.g. read :: String -> Int. But if it's not possible to parse [c] as an int (e.g. "a"), read will throw an exception:
> digit 1 "doesnt start with a digit"
*** Exception: Prelude.read: no parse
> -- other example
> (read :: String -> Int) "a"
*** Exception: Prelude.read: no parse
Instead, go the other way:
if [c] == show i then Just i else Nothing
This will always works, since show won't fail (not counting cases where bottom is involved).
I'm trying to complete the last part of my Haskell homework and I'm stuck, my code so far:
data Entry = Entry (String, String)
class Lexico a where
(<!), (=!), (>!) :: a -> a -> Bool
instance Lexico Entry where
Entry (a,_) <! Entry (b,_) = a < b
Entry (a,_) =! Entry (b,_) = a == b
Entry (a,_) >! Entry (b,_) = a > b
entries :: [(String, String)]
entries = [("saves", "en vaut"), ("time", "temps"), ("in", "<`a>"),
("{", "{"), ("A", "Un"), ("}", "}"), ("stitch", "point"),
("nine.", "cent."), ("Zazie", "Zazie")]
build :: (String, String) -> Entry
build (a, b) = Entry (a, b)
diction :: [Entry]
diction = quiksrt (map build entries)
size :: [a] -> Integer
size [] = 0
size (x:xs) = 1+ size xs
quiksrt :: Lexico a => [a] -> [a]
quiksrt [] = []
quiksrt (x:xs)
|(size [y|y <- xs, y =! x]) > 0 = error "Duplicates not allowed."
|otherwise = quiksrt [y|y <- xs, y <! x]++ [x] ++ quiksrt [y|y <- xs, y >! x]
english :: String
english = "A stitch in time save nine."
show :: Entry -> String
show (Entry (a, b)) = "(" ++ Prelude.show a ++ ", " ++ Prelude.show b ++ ")"
showAll :: [Entry] -> String
showAll [] = []
showAll (x:xs) = Main.show x ++ "\n" ++ showAll xs
main :: IO ()
main = do putStr (showAll ( diction ))
The question asks:
Write a Haskell programs that takes
the English sentence 'english', looks
up each word in the English-French
dictionary using binary search,
performs word-for-word substitution,
assembles the French translation, and
prints it out.
The function 'quicksort' rejects
duplicate entries (with 'error'/abort)
so that there is precisely one French
definition for any English word. Test
'quicksort' with both the original
'raw_data' and after having added
'("saves", "sauve")' to 'raw_data'.
Here is a von Neumann late-stopping
version of binary search. Make a
literal transliteration into Haskell.
Immediately upon entry, the Haskell
version must verify the recursive
"loop invariant", terminating with
'error'/abort if it fails to hold. It
also terminates in the same fashion if
the English word is not found.
function binsearch (x : integer) : integer
local j, k, h : integer
j,k := 1,n
do j+1 <> k --->
h := (j+k) div 2
{a[j] <= x < a[k]} // loop invariant
if x < a[h] ---> k := h
| x >= a[h] ---> j := h
fi
od
{a[j] <= x < a[j+1]} // termination assertion
found := x = a[j]
if found ---> return j
| not found ---> return 0
fi
In the Haskell version
binsearch :: String -> Integer -> Integer -> Entry
as the constant dictionary 'a' of type
'[Entry]' is globally visible. Hint:
Make your string (English word) into
an 'Entry' immediately upon entering
'binsearch'.
The programming value of the
high-level data type 'Entry' is that,
if you can design these two functions
over the integers, it is trivial to
lift them to to operate over Entry's.
Anybody know how I'm supposed to go about my binarysearch function?
The instructor asks for a "literal transliteration", so use the same variable names, in the same order. But note some differences:
the given version takes only 1
parameter, the signature he gives
requires 3. Hmmm,
the given version is not recursive, but he asks for a
recursive version.
Another answer says to convert to an Array, but for such a small exercise (this is homework after all), I felt we could pretend that lists are direct access. I just took your diction::[Entry] and indexed into that. I did have to convert between Int and Integer in a few places.
Minor nit: You've got a typo in your english value (bs is a shortcut to binSearch I made):
*Main> map bs (words english)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),*** Exception: Not found
*Main> map bs (words englishFixed)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),Entry ("saves","en vaut"),Entry ("nine.","cent.")]
*Main>
A binary search needs random access, which is not possible on a list. So, the first thing to do would probably be to convert the list to an Array (with listArray), and do the search on it.
here's my code for just the English part of the question (I tested it and it works perfectly) :
module Main where
class Lex a where
(<!), (=!), (>!) :: a -> a -> Bool
data Entry = Entry String String
instance Lex Entry where
(Entry a _) <! (Entry b _) = a < b
(Entry a _) =! (Entry b _) = a == b
(Entry a _) >! (Entry b _) = a > b
-- at this point, three binary (infix) operators on values of type 'Entry'
-- have been defined
type Raw = (String, String)
raw_data :: [Raw]
raw_data = [("than a", "qu'un"), ("saves", "en vaut"), ("time", "temps"),
("in", "<`a>"), ("worse", "pire"), ("{", "{"), ("A", "Un"),
("}", "}"), ("stitch", "point"), ("crime;", "crime,"),
("a", "une"), ("nine.", "cent."), ("It's", "C'est"),
("Zazie", "Zazie"), ("cat", "chat"), ("it's", "c'est"),
("raisin", "raisin sec"), ("mistake.", "faute."),
("blueberry", "myrtille"), ("luck", "chance"),
("bad", "mauvais")]
cook :: Raw -> Entry
cook (x, y) = Entry x y
a :: [Entry]
a = map cook raw_data
quicksort :: Lex a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort (filter (<! x) xs) ++ [x] ++ quicksort (filter (=! x) xs) ++ quicksort (filter (>! x) xs)
getfirst :: Entry -> String
getfirst (Entry x y) = x
getsecond :: Entry -> String
getsecond (Entry x y) = y
binarysearch :: String -> [Entry] -> Int -> Int -> String
binarysearch s e low high
| low > high = " NOT fOUND "
| getfirst ((e)!!(mid)) > s = binarysearch s (e) low (mid-1)
| getfirst ((e)!!(mid)) < s = binarysearch s (e) (mid+1) high
| otherwise = getsecond ((e)!!(mid))
where mid = (div (low+high) 2)
translator :: [String] -> [Entry] -> [String]
translator [] y = []
translator (x:xs) y = (binarysearch x y 0 ((length y)-1):translator xs y)
english :: String
english = "A stitch in time saves nine."
compute :: String -> [Entry] -> String
compute x y = unwords(translator (words (x)) y)
main = do
putStr (compute english (quicksort a))
An important Prelude operator is:
(!!) :: [a] -> Integer -> a
-- xs!!n returns the nth element of xs, starting at the left and
-- counting from 0.
Thus, [14,7,3]!!1 ~~> 7.