Help on simpleHttp in Network.HTTP.Conduit problem

I copied and pasted some html parsing demo source from FP School. While the code works on the FP demo site (in the IDE), I get the following error on my Windows 7 64 bit: InternalIOException getAddrInfo: does not exist (error 10093). Thanks

Here is the source by the way: {-# LANGUAGE OverloadedStrings #-} import Network.HTTP.Conduit (simpleHttp) import qualified Data.Text as T import Text.HTML.DOM (parseLBS) import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, child, ($//), (&|), (&//), (>=>)) -- The URL we're going to search url = "http://www.bing.com/search?q=school+of+haskell" -- The data we're going to search for findNodes :: Cursor -> [Cursor] findNodes = element "span" >=> attributeIs "id" "count" >=> child -- Extract the data from each node in turn extractData = T.concat . content -- Process the list of data elements processData = putStrLn . T.unpack . T.concat cursorFor :: String -> IO Cursor cursorFor u = do page <- simpleHttp u return $ fromDocument $ parseLBS page -- test main = do cursor <- cursorFor url processData $ cursor $// findNodes &| extractData On Tuesday, January 21, 2014 2:10:19 PM UTC-8, Stuart Mills wrote:
I copied and pasted some html parsing demo source from FP School.
While the code works on the FP demo site (in the IDE), I get the following error on my Windows 7 64 bit:
InternalIOException getAddrInfo: does not exist (error 10093).
Thanks

It looks like you haven't initialized the networking subsystem. See
http://hackage.haskell.org/package/network-2.4.2.2/docs/Network.html#g:2
* Stuart Mills
Here is the source by the way: {-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit (simpleHttp) import qualified Data.Text as T import Text.HTML.DOM (parseLBS) import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, child, ($//), (&|), (&//), (>=>))
-- The URL we're going to search url = "http://www.bing.com/search?q=school+of+haskell"
-- The data we're going to search for findNodes :: Cursor -> [Cursor] findNodes = element "span" >=> attributeIs "id" "count" >=> child
-- Extract the data from each node in turn extractData = T.concat . content
-- Process the list of data elements processData = putStrLn . T.unpack . T.concat
cursorFor :: String -> IO Cursor cursorFor u = do page <- simpleHttp u return $ fromDocument $ parseLBS page
-- test main = do cursor <- cursorFor url processData $ cursor $// findNodes &| extractData
On Tuesday, January 21, 2014 2:10:19 PM UTC-8, Stuart Mills wrote:
I copied and pasted some html parsing demo source from FP School.
While the code works on the FP demo site (in the IDE), I get the following error on my Windows 7 64 bit:
InternalIOException getAddrInfo: does not exist (error 10093).
Thanks
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi Stuart,
I was going to suggest the same as Roman, this is a "known problem" on
Windows. But the good news is that withSocketsDo is implemented as "id"
if you are on Unix, so you could still write multi platform programs
without worrying about platforms and preprocessor flags.
Hope this helps!
Alfredo
On 21 January 2014 23:14, Roman Cheplyaka
It looks like you haven't initialized the networking subsystem. See http://hackage.haskell.org/package/network-2.4.2.2/docs/Network.html#g:2
* Stuart Mills
[2014-01-21 14:39:36-0800] Here is the source by the way: {-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit (simpleHttp) import qualified Data.Text as T import Text.HTML.DOM (parseLBS) import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, child, ($//), (&|), (&//), (>=>))
-- The URL we're going to search url = "http://www.bing.com/search?q=school+of+haskell"
-- The data we're going to search for findNodes :: Cursor -> [Cursor] findNodes = element "span" >=> attributeIs "id" "count" >=> child
-- Extract the data from each node in turn extractData = T.concat . content
-- Process the list of data elements processData = putStrLn . T.unpack . T.concat
cursorFor :: String -> IO Cursor cursorFor u = do page <- simpleHttp u return $ fromDocument $ parseLBS page
-- test main = do cursor <- cursorFor url processData $ cursor $// findNodes &| extractData
On Tuesday, January 21, 2014 2:10:19 PM UTC-8, Stuart Mills wrote:
I copied and pasted some html parsing demo source from FP School.
While the code works on the FP demo site (in the IDE), I get the
following
error on my Windows 7 64 bit:
InternalIOException getAddrInfo: does not exist (error 10093).
Thanks
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (3)
-
Alfredo Di Napoli
-
Roman Cheplyaka
-
Stuart Mills