Commit b635d31b authored by Alexandre Delanoë's avatar Alexandre Delanoë

[CLEAN] working function

parent 59c82079
module Main where module Main where
import qualified Network.Api.Arxiv as Ax import Arxiv (main')
import Network.Api.Arxiv (Expression(..),
Field(..), (/*/), (/+/),(/-/))
import Network.Socket (withSocketsDo)
import Network.HTTP.Simple as HT
import Network.HTTP.Conduit (parseRequest)
import Network.HTTP.Types.Status
import Data.List (intercalate)
import qualified Data.ByteString as B hiding (unpack)
import qualified Data.ByteString.Char8 as B (unpack)
import Data.Conduit ((.|))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Function ((&))
import Text.HTML.TagSoup
import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Resource (MonadResource)
import Control.Applicative ((<$>))
main :: IO () main :: IO ()
main = withSocketsDo (execQuery makeQuery) main = undefined
makeQuery :: Ax.Query
makeQuery =
let au = Exp $ Au ["Aaronson"]
t1 = Exp $ Ti ["quantum"]
t2 = Exp $ Ti ["complexity"]
x = au /*/ (t1 /+/ t2)
in Ax.Query {
Ax.qExp = Just x,
Ax.qIds = [],
Ax.qStart = 0,
Ax.qItems = 25}
type Soup = Tag String
execQuery :: Ax.Query -> IO ()
execQuery q = C.runConduitRes (searchAxv q .| outSnk)
----------------------------------------------------------------------
-- Execute query and start a source
----------------------------------------------------------------------
searchAxv :: MonadResource m => Ax.Query -> C.ConduitT () String m ()
searchAxv q =
let s = Ax.mkQuery q
in do rsp <- HT.httpBS =<< liftIO (parseRequest s)
case getResponseStatus rsp of
(Status 200 _) -> getSoup (getResponseBody rsp)
>>= results q
st -> error $ "Error:" ++ show st
----------------------------------------------------------------------
-- Consume page by page
----------------------------------------------------------------------
getSoup :: MonadResource m =>
B.ByteString -> C.ConduitT () String m [Soup]
getSoup b = concat <$> (C.yield b .| toSoup .| CL.consume)
----------------------------------------------------------------------
-- Receive a ByteString and yield Soup
----------------------------------------------------------------------
toSoup :: MonadResource m => C.ConduitT B.ByteString [Soup] m ()
toSoup = C.awaitForever (C.yield . parseTags . B.unpack)
----------------------------------------------------------------------
-- Yield all entries and fetch next page
----------------------------------------------------------------------
results :: MonadResource m =>
Ax.Query -> [Soup] -> C.ConduitT () String m ()
results q sp =
if Ax.exhausted sp
then C.yield ("EOT: " ++ show (Ax.totalResults sp) ++ " results")
else Ax.forEachEntryM_ sp (C.yield . mkResult)
>> searchAxv (Ax.nextPage q)
----------------------------------------------------------------------
-- Get data and format
----------------------------------------------------------------------
mkResult :: [Soup] -> String
mkResult sp = let aus = Ax.getAuthorNames sp
y = Ax.getYear sp
tmp = Ax.getTitle sp & clean ['\n', '\r', '\t']
ti = if null tmp then "No title" else tmp
in intercalate ", " aus ++ " (" ++ y ++ "): " ++ ti
where clean _ [] = []
clean d (c:cs) | c `elem` d = clean d cs
| otherwise = c:clean d cs
----------------------------------------------------------------------
-- Sink results
----------------------------------------------------------------------
outSnk :: MonadResource m => C.ConduitT String C.Void m ()
outSnk = C.awaitForever (liftIO . putStrLn)
module Arxiv where module Arxiv where
import qualified Network.Api.Arxiv as Ax import Control.Applicative ((<$>))
import Network.Api.Arxiv (Expression(..), import Control.Monad.Trans (liftIO)
Field(..), (/*/), (/+/),(/-/)) import Control.Monad.Trans.Resource (MonadResource)
import Network.Socket (withSocketsDo) import Data.Conduit ((.|))
import Network.HTTP.Simple as HT import Data.Function ((&))
import Network.HTTP.Conduit (parseRequest) import Data.List (intercalate)
import Network.HTTP.Types.Status import Network.Api.Arxiv (Expression(..), Field(..), (/*/), (/+/),(/-/))
import Data.List (intercalate) import Network.HTTP.Conduit (parseRequest)
import Network.HTTP.Simple as HT
import Network.HTTP.Types.Status
import Network.Socket (withSocketsDo)
import Text.HTML.TagSoup
import Debug.Trace (trace)
import qualified Data.ByteString as B hiding (unpack) import qualified Data.ByteString as B hiding (unpack)
import qualified Data.ByteString.Char8 as B (unpack) import qualified Data.ByteString.Char8 as B (unpack)
import Data.Conduit ((.|))
import qualified Data.Conduit as C import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL import qualified Data.Conduit.List as CL
import Data.Function ((&)) import qualified Network.Api.Arxiv as Ax
import Text.HTML.TagSoup
import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Resource (MonadResource)
import Control.Applicative ((<$>))
main'' :: IO ()
main'' = withSocketsDo (execQuery makeQuery)
main' :: IO [Result] main' :: IO [Result]
main' = withSocketsDo (execQuery' makeQuery) main' = withSocketsDo (execQuery' makeQuery)
...@@ -33,14 +35,18 @@ makeQuery = ...@@ -33,14 +35,18 @@ makeQuery =
in Ax.Query { in Ax.Query {
Ax.qExp = Just $ Exp $ All ["nuclear fusion"], Ax.qExp = Just $ Exp $ All ["nuclear fusion"],
Ax.qIds = [], Ax.qIds = [],
Ax.qStart = 500, Ax.qStart = 0,
Ax.qItems = 25} Ax.qItems = 25}
type Soup = Tag String type Soup = Tag String
execQuery :: Ax.Query -> IO ()
execQuery q = C.runConduitRes (searchAxv' q .| outSnk)
execQuery' :: Ax.Query -> IO [Result] execQuery' :: Ax.Query -> IO [Result]
execQuery' q = C.runConduitRes (searchAxv' q .| CL.consume) -- .| outSnk') execQuery' q = C.runConduitRes (searchAxv' q .| CL.take 10) -- .| outSnk')
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Execute query and start a source -- Execute query and start a source
...@@ -84,14 +90,14 @@ results' q sp = ...@@ -84,14 +90,14 @@ results' q sp =
data Result = Result { authorNames :: String data Result = Result { authorNames :: String
, year :: String , year :: String
, title :: String , title :: String
} } deriving (Show)
mkResult' :: [Soup] -> Result mkResult' :: [Soup] -> Result
mkResult' sp = let aus = Ax.getAuthorNames sp mkResult' sp = let aus = Ax.getAuthorNames sp
y = Ax.getYear sp y = Ax.getYear sp
tmp = Ax.getTitle sp & clean ['\n', '\r', '\t'] tmp = Ax.getTitle sp & clean ['\n', '\r', '\t']
ti = if null tmp then "No title" else tmp ti = if null tmp then "No title" else tmp
in Result (intercalate " " aus) y ti in trace ti $ Result (intercalate " " aus) y ti
where clean _ [] = [] where clean _ [] = []
clean d (c:cs) | c `elem` d = clean d cs clean d (c:cs) | c `elem` d = clean d cs
| otherwise = c:clean d cs | otherwise = c:clean d cs
...@@ -100,8 +106,8 @@ mkResult' sp = let aus = Ax.getAuthorNames sp ...@@ -100,8 +106,8 @@ mkResult' sp = let aus = Ax.getAuthorNames sp
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Sink results -- Sink results
---------------------------------------------------------------------- ----------------------------------------------------------------------
outSnk :: MonadResource m => C.ConduitT String C.Void m () outSnk :: MonadResource m => C.ConduitT Result C.Void m ()
outSnk = C.awaitForever (liftIO . putStrLn) outSnk = C.awaitForever (liftIO . putStrLn . show)
{- {-
outSnk' :: MonadResource m => C.ConduitT Result Result m () -- [Result] outSnk' :: MonadResource m => C.ConduitT Result Result m () -- [Result]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment