I am learning Haskell, and having a great time. One of the things I especially enjoy is using the monad error types to propagate error conditions behind the scene in fmap or >>=. For example, in this code, I am using hoauth2 for an authenticated connection. It defines OAuth2Result using Either...
type OAuth2Result a = Either ByteString a -- from OAuth2
getEntries :: Manager -> AccessToken -> IO(OAuth2Result [Entry])
-- code omitted
filterResults :: [Entry] -> OAuth2Result [Entry]
filterResults = return $ filter hasUrl
printEntries :: [Entry] -> IO() -- What type can I use here?
printEntries Left l = -- code omitted
printEntries Right r = -- code omitted
main = do
entriesResult <- getEntries mgr token -- This is an OAuth2Result
let filtered = entriesResult >>= filterResults
printEntries filtered
The problem that I am having is when a function has IO like printEntries. In this case, I have to explicitly pattern match to do the error handling. I would sure love to be able to hide it somehow as I did with the filterResults call.
How can I do this?
Thanks!
Here's how to do it with runEitherT which requires some lifting and hoisting to get the types right:
import Control.Monad
import Control.Monad.Trans
import Control.Error
import Data.List (isInfixOf)
type Entry = String
type Result a = Either String a
sampleEntries = [ "good 1", "good 2", "good 3", "bad 4", "good 5", "bad 6", "good 7" ]
getEntries :: Int -> IO (Result [Entry])
getEntries n = if n >= 0 && n <= length sampleEntries
then return $ Right $ take n sampleEntries
else return $ Left $ "invalid n: " ++ show n
filterEntries :: [Entry] -> Result [Entry]
filterEntries ents = if all isGood ents
then Right $ ents
else Left "found a bad entry"
where isGood str = isInfixOf "good" str
printEntries :: [Entry] -> IO ()
printEntries ents = forM_ (zip [1..] ents) $ \(i,e) -> print (i,e)
doit n = do
ents <- (lift $ getEntries n) >>= hoistEither
filtered <- hoistEither $ filterEntries ents
lift $ printEntries filtered
main n = do result <- runEitherT $ doit n
case result of
Left e -> putStrLn $ "Error: " ++ e
Right _ -> putStrLn $ "no errors"
Note the following behavior:
main 100 fails because getEntries returns an error
main 4 fails because filterEntries returns an error
main 3 succeeds
Related
I am scraping https://books.toscrape.com using Haskell's Scalpel library. Here's my code so far:
import Text.HTML.Scalpel
import Data.List.Split (splitOn)
import Data.List (sortBy)
import Control.Monad (liftM2)
data Entry = Entry {entName :: String
, entPrice :: Float
, entRate :: Int
} deriving Eq
instance Show Entry where
show (Entry n p r) = "Name: " ++ n ++ "\nPrice: " ++ show p ++ "\nRating: " ++ show r ++ "/5\n"
entries :: Maybe [Entry]
entries = Just []
scrapePage :: Int -> IO ()
scrapePage num = do
items <- scrapeURL ("https://books.toscrape.com/catalogue/page-" ++ show num ++ ".html") allItems
let sortedItems = items >>= Just . sortBy (\(Entry _ a _) (Entry _ b _) -> compare a b)
>>= Just . filter (\(Entry _ _ r) -> r == 5)
maybe (return ()) (mapM_ print) sortedItems
allItems :: Scraper String [Entry]
allItems = chroots ("article" #: [hasClass "product_pod"]) $ do
p <- text $ "p" #: [hasClass "price_color"]
t <- attr "href" $ "a"
star <- attr "class" $ "p" #: [hasClass "star-rating"]
let fp = read $ flip (!!) 1 $ splitOn "£" p
let fStar = drop 12 star
return $ Entry t fp $ r fStar
where
r f = case f of
"One" -> 1
"Two" -> 2
"Three" -> 3
"Four" -> 4
"Five" -> 5
main :: IO ()
main = mapM_ scrapePage [1..10]
Basically, allItems scrapes for each book's title, price and rating, does some formatting for price to get a float, and returns it as a type Entry. scrapePage takes a number corresponding to the result page number, scrapes that page to get IO (Maybe [Entry]), formats it - in this case, to filter for 5-star books and order by price - and prints each Entry. main performs scrapePage over pages 1 to 10.
The problem I've run into is that my code scrapes, filters and sorts each page, whereas I want to scrape all the pages then filter and sort.
What worked for two pages (in GHCi) was:
i <- scrapeURL ("https://books.toscrape.com/catalogue/page-1.html") allItems
j <- scrapeURL ("https://books.toscrape.com/catalogue/page-2.html") allItems
liftM2 (++) i j
This returns a list composed of page 1 and 2's results that I could then print, but I don't know how to implement this for all 50 result pages. Help would be appreciated.
Just return the entry list without any processing (or you can do filtering in this stage)
-- no error handling
scrapePage :: Int -> IO [Entry]
scrapePage num =
concat . maybeToList <$> scrapeURL ("https://books.toscrape.com/catalogue/page-" ++ show num ++ ".html") allItems
Then you can process them later together
process = filter (\e -> entRate e == 5) . sortOn entPrice
main = do
entries <- concat <$> mapM scrapePage [1 .. 10]
print $ process entries
Moreover you can easily make your code concurrent with mapConcurrently from async package
main = do
entries <- concat <$> mapConcurrently scrapePage [1 .. 20]
print $ process entries
I think I understand how to cascade Monad of the same type. I would like to combine two Monads together to perform an operation based on them :
I think the code below resume the problem : suppose we have a function that validates that a String contains "Jo" and append "Bob" to it if it's the case, and another one that validates that the String length is > 8
The hello function would apply the first , then the second on the result of the first and return "Hello" to all that in case of success or 'Nothing' (I don't know what is this 'Nothing' btw , Left or Nothing) in case of error.
I believe that it's around Monad transformer what I need but I could not find a concise example that would help me to start.
I precise that this is nothing theoratical as there is around Haskell package that works with Either and others that works with Maybe
validateContainsJoAndAppendBob :: String -> Maybe String
validateContainsJoAndAppendBob l =
case isInfixOf "Jo" l of
False -> Nothing
True -> Just $ l ++ "Bob"
validateLengthFunction :: Foldable t => t a -> Either String (t a)
validateLengthFunction l =
case (length l > 8) of
False -> Left "to short"
True -> Right l
-- hello l = do
-- v <- validateContainsJoAndAppendBob l
-- r <- validateLengthFunction v
-- return $ "Hello " ++ r
Use a function to convert Maybe to Either
note :: Maybe a -> e -> Either e a
note Nothing e = Left e
note (Just a) _ = Right a
hello l = do
v <- validateContainsJoAndAppendBob l `note` "Does not contain \"Jo\""
r <- validateLengthFunction v
return $ "Hello " ++ r
In addition to the practical answer given by Li-yao Xia, there's other alternatives. Here's two.
Maybe-Either isomorphism
Maybe a is isomorphic to Either () a, which means that there's a lossless translation between the two:
eitherFromMaybe :: Maybe a -> Either () a
eitherFromMaybe (Just x) = Right x
eitherFromMaybe Nothing = Left ()
maybeFromEither :: Either () a -> Maybe a
maybeFromEither (Right x) = Just x
maybeFromEither (Left ()) = Nothing
You can use one of these to translate to the other. Since validateLengthFunction returns an error text on failure, it would be a lossy translation to turn its return value into a Maybe String value, so it's better to use eitherFromMaybe.
The problem with that, though, is that this will only give you an Either () String value, and you need an Either String String. You can solve this by taking advantage of Either being a Bifunctor instance. First,
import Data.Bifunctor
and then you can write hello as:
hello :: String -> Either String String
hello l = do
v <-
first (const "Doesn't contain 'Jo'.") $
eitherFromMaybe $
validateContainsJoAndAppendBob l
r <- validateLengthFunction v
return $ "Hello " ++ r
This essentially does the same as Li-yao Xia's answer - a little less practical, but also a little less ad-hoc.
The first function maps the first (left-most) case of an Either value. In this case, if the return value from validateContainsJoAndAppendBob is a Left value, it's always going to be Left (), so you can use const to ignore the () input and return a String value.
This gets the job done:
*Q49816908> hello "Job, "
Left "to short"
*Q49816908> hello "Cool job, "
Left "Doesn't contain 'Jo'."
*Q49816908> hello "Cool Job, "
Right "Hello Cool Job, Bob"
This alternative I prefer to the next one, but just for completeness' sake:
Monad transformers
Another option is using Monad transformers. You can either wrap the Maybe in an EitherT, or conversely wrap an Either in MaybeT. The following example does the latter.
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT(..))
helloT :: String -> MaybeT (Either String) String
helloT l = do
v <- MaybeT $ return $ validateContainsJoAndAppendBob l
r <- lift $ validateLengthFunction v
return $ "Hello " ++ r
This also works, but here you still have to deal with the various combinations of Just, Nothing, Left, and Right:
*Q49816908> helloT "Job, "
MaybeT (Left "to short")
*Q49816908> helloT "Cool job, "
MaybeT (Right Nothing)
*Q49816908> helloT "Cool Job, "
MaybeT (Right (Just "Hello Cool Job, Bob"))
If you want to peel off the MaybeT wrapper, you can use runMaybeT:
*Q49816908> runMaybeT $ helloT "Cool Job, "
Right (Just "Hello Cool Job, Bob")
In most cases, I'd probably go with the first option...
What you want is (in the categorical sense) a natural transformation from Maybe to Either String, which the maybe function can provide.
maybeToEither :: e -> Maybe a -> Either e a
maybeToEither e = maybe (Left e) Right
hello l = do
v <- maybeToEither "No Jo" (validateContainsJoAndAppendBob l)
r <- validateLengthFunction v
return $ "Hello " ++ r
You can use <=< from Control.Monad to compose the two validators.
hello l = do
r <- validateLengthFunction <=< maybeToEither "No Jo" . validateContainsJoAndAppendBob $ l
return $ "Hello " ++ r
You can also use >=> and return to turn the whole thing into a single monstrous point-free definition.
hello = maybeToEither "No Jo" . validateContainsJoAndAppendBob
>=> validateLengthFunction
>=> return . ("Hello " ++)
I have an AST representing a haskell program and a bitvector/bool list representing the presence of strictness annotations on Patterns in order.For example, 1000 represents a program with 4 Pats where the first one is a BangPat. Is there any way that I can turn on and off the annotations in the AST according to the list?
-- EDIT: further clarify what I want editBang to do
Based on user5042's answer:
Simple.hs :=
main = do
case args of
[] -> error "blah"
[!x] -> putStrLn "one"
(!x : xs) -> putStrLn "many"
And I want editBang "Simple.hs" [True, True, True, True] to produce
main = do
case args of
[] -> error "blah"
[!x] -> putStrLn "one"
(!(!x : !xs)) -> putStrLn "many"
Given that above are the only 4 places that ! can appear
As a first step, here's how to use transformBi:
import Data.Data
import Control.Monad
import Data.Generics.Uniplate.Data
import Language.Haskell.Exts
import Text.Show.Pretty (ppShow)
changeNames x = transformBi change x
where change (Ident str) = Ident ("foo_" ++ str)
change x = x
test2 = do
content <- readFile "Simple.hs"
case parseModule content of
ParseFailed _ e -> error e
ParseOk a -> do
let a' = changeNames a
putStrLn $ ppShow a'
The changeNames function finds all occurrences of a Ident s and replaces it with Ident ("foo_"++s) in the source tree.
There is a monadic version called transformBiM which allows the replacement function to be monadic which would allow you to consume elements from your list of Bools as you found bang patterns.
Here is a complete working example:
import Control.Monad
import Data.Generics.Uniplate.Data
import Language.Haskell.Exts
import Text.Show.Pretty (ppShow)
import Control.Monad.State.Strict
parseHaskell path = do
content <- readFile path
let mode = ParseMode path Haskell2010 [EnableExtension BangPatterns] False False Nothing
case parseModuleWithMode mode content of
ParseFailed _ e -> error $ path ++ ": " ++ e
ParseOk a -> return a
changeBangs bools x = runState (transformBiM go x) bools
where go pp#(PBangPat p) = do
(b:bs) <- get
put bs
if b
then return p
else return pp
go x = return x
test = do
a <- parseHaskell "Simple.hs"
putStrLn $ unlines . map ("before: " ++) . lines $ ppShow a
let a' = changeBangs [True,False] a
putStrLn $ unlines . map ("after : " ++) . lines $ ppShow a'
You might also look into using rewriteBiM.
The file Simple.hs:
main = do
case args of
[] -> error "blah"
[!x] -> putStrLn "one"
(!x : xs) -> putStrLn "many"
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.
I'd like to pass an integer as a CLI argument to a Haskell program that makes use of QuickCheck / monadicIO. That integer is going to be used inside the assert to make the tests customizable.
The problem is that once I parse the integer value in main, I don't know how to pass it inside of the monadicIO call without using something as ugly as an IORef. I would think that an elegant solution might be the Reader monad, but I couldn't find a solution to make it work, seen as quickCheck is rigid in its arguments.
Any ideas?
Later Edit 1: As requested, I'm attaching the actual code I'm trying this on, and failing. The commented-out lines represent my failed attempt. Background: the test suite is intended to exercise a very simple remote endpoint that computes the SHA512 of the randomized input generated by QuickCheck. The remote endpoint is Python/Flask based.
Later Edit 2 in response to #user2407038: I could make propHasExpectedLengthCeiling take an additional argument of type Int, but quickCheck would generate random values for it, and that's not what I want happening. My goal is to use the maxSegmentLengthCeiling that I'm taking in from the command-line arguments and use it in let testPassed = actualMaxSegmentLength <= maxSegmentLengthCeiling inside of the monadicIO block. Right now maxSegmentLengthCeiling is specified as a top-level value, which means I have to recompile the code every time I change the value. I don't yet have any code that involves IORef because that's a last resort and the essence of my question is how to avoid going the IORef route.
import qualified Data.ByteString.Lazy.Char8 as LC
import Control.Applicative ( (<$>) )
import Data.Function ( on )
import Data.List ( groupBy )
import Data.Char ( isDigit )
--import Safe ( headMay
-- , readMay
-- )
--import System.Environment ( getArgs )
import Network.HTTP.Conduit ( simpleHttp )
import Test.QuickCheck ( Arbitrary
, Property
, arbitrary
, choose
, frequency
, quickCheckWith
, stdArgs
, vectorOf
)
import Test.QuickCheck.Test ( Args
, maxSuccess
)
import Test.QuickCheck.Monadic ( assert
, monadicIO
, run
)
newtype CustomInput = MkCustomInput String deriving Show
instance Arbitrary CustomInput where
arbitrary =
let
genCustomInput = vectorOf 20
$ frequency [ (26, choose ('0','9'))
, (10, choose ('a','z'))
]
in
MkCustomInput <$> genCustomInput
maxSegmentLengthCeiling :: Int
maxSegmentLengthCeiling = 22
urlPrefix :: String
urlPrefix = "http://192.168.2.3:5000/sha512sum/"
propHasExpectedLengthCeiling :: CustomInput -> Property
propHasExpectedLengthCeiling (MkCustomInput input) = monadicIO $ do
testPassed <- run $ do
response <- simpleHttp $ urlPrefix ++ input
let stringResponse = LC.unpack response
let brokenDownStringResponse = groupBy ( (==) `on` isDigit ) stringResponse
let actualMaxSegmentLength = maximum $ map length brokenDownStringResponse
let testPassed = actualMaxSegmentLength <= maxSegmentLengthCeiling
putStrLn ""
putStrLn ""
putStrLn $ "Input: " ++ input
putStrLn $ "Control sum: " ++ stringResponse
putStrLn $ "Breakdown: " ++ show brokenDownStringResponse
putStrLn $ "Max. length: " ++ show actualMaxSegmentLength
putStrLn $ "Ceiling: " ++ show maxSegmentLengthCeiling
putStrLn $ "Test result: " ++ if testPassed then "Pass" else "Fail"
putStrLn ""
putStrLn ""
return testPassed
assert $ testPassed
customArgs :: Args
customArgs = stdArgs { maxSuccess = 1000000 }
--readMayAsInt :: String -> Maybe Int
--readMayAsInt = readMay
main :: IO ()
main =
--main = do
-- cliArgs <- getArgs
-- let ceilingInputMay = headMay cliArgs >>= readMayAsInt
-- maxSegmentLengthCeiling <- case ceilingInputMay of
-- (Just lengthCeiling) -> return lengthCeiling
-- Nothing -> error "No valid number given"
quickCheckWith
customArgs
propHasExpectedLengthCeiling
Make maxSegmentLengthCeiling a parameter to propHasExpectedLengthCeiling :
propHasExpectedLengthCeiling :: Int -> CustomInput -> Property
and invoke it as
main = do
[n] <- getArgs
quickCheckWith customArgs (propHasExpectedLengthCeiling (read n))