Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
A
ad-listener
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Insights
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Security & Compliance
Security & Compliance
Dependency List
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Joris
ad-listener
Commits
96bbdbbe
Commit
96bbdbbe
authored
Jun 18, 2018
by
Joris
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix ouest france ads encoding
parent
3717598b
Changes
4
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
83 additions
and
68 deletions
+83
-68
src/executable/haskell/Service/AdListener.hs
src/executable/haskell/Service/AdListener.hs
+19
-2
src/executable/haskell/Utils/HTTP.hs
src/executable/haskell/Utils/HTTP.hs
+6
-7
src/parser/haskell/Parser/Utils.hs
src/parser/haskell/Parser/Utils.hs
+0
-1
src/test/haskell/Main.hs
src/test/haskell/Main.hs
+58
-58
No files found.
src/executable/haskell/Service/AdListener.hs
View file @
96bbdbbe
...
@@ -4,6 +4,7 @@ module Service.AdListener
...
@@ -4,6 +4,7 @@ module Service.AdListener
import
Control.Concurrent
(
threadDelay
)
import
Control.Concurrent
(
threadDelay
)
import
Data.Either
(
rights
)
import
Data.Either
(
rights
)
import
Data.Text.Encoding
as
T
import
qualified
Data.Text.IO
as
T
import
qualified
Data.Text.IO
as
T
import
Prelude
hiding
(
error
)
import
Prelude
hiding
(
error
)
...
@@ -47,14 +48,30 @@ listenToNewAdsWithViewedURLs conf viewedURLs = do
...
@@ -47,14 +48,30 @@ listenToNewAdsWithViewedURLs conf viewedURLs = do
fetchAds
::
Conf
->
IO
[
Ad
]
fetchAds
::
Conf
->
IO
[
Ad
]
fetchAds
conf
=
do
fetchAds
conf
=
do
leboncoinAds
<-
fmap
(
concat
.
map
LeboncoinParser
.
parse
.
rights
)
.
sequence
.
map
HTTP
.
get
.
Conf
.
leboncoinUrls
$
conf
leboncoinAds
<-
getLeboncoinAds
conf
ouestFranceAds
<-
fmap
(
concat
.
map
OuestFranceParser
.
parse
.
rights
)
.
sequence
.
map
HTTP
.
get
.
Conf
.
ouestFranceUrls
$
conf
ouestFranceAds
<-
getOuestFranceAds
conf
let
results
=
leboncoinAds
++
ouestFranceAds
let
results
=
leboncoinAds
++
ouestFranceAds
if
null
results
if
null
results
then
T
.
putStrLn
"Parsed 0 results!"
then
T
.
putStrLn
"Parsed 0 results!"
else
return
()
else
return
()
return
results
return
results
getLeboncoinAds
::
Conf
->
IO
[
Ad
]
getLeboncoinAds
conf
=
fmap
(
concat
.
map
LeboncoinParser
.
parse
.
rights
)
.
sequence
.
map
(
HTTP
.
get
T
.
decodeLatin1
)
.
Conf
.
leboncoinUrls
$
conf
getOuestFranceAds
::
Conf
->
IO
[
Ad
]
getOuestFranceAds
conf
=
fmap
(
concat
.
map
OuestFranceParser
.
parse
.
rights
)
.
sequence
.
map
(
HTTP
.
get
T
.
decodeUtf8
)
.
Conf
.
ouestFranceUrls
$
conf
sendMail
::
Conf
->
[
Ad
]
->
IO
()
sendMail
::
Conf
->
[
Ad
]
->
IO
()
sendMail
conf
ads
=
sendMail
conf
ads
=
let
(
title
,
plainBody
)
=
Ad
.
renderAds
ads
let
(
title
,
plainBody
)
=
Ad
.
renderAds
ads
...
...
src/executable/haskell/Utils/HTTP.hs
View file @
96bbdbbe
...
@@ -3,18 +3,17 @@ module Utils.HTTP
...
@@ -3,18 +3,17 @@ module Utils.HTTP
)
where
)
where
import
Control.Exception
(
SomeException
,
try
)
import
Control.Exception
(
SomeException
,
try
)
import
Data.ByteString
(
ByteString
)
import
Data.ByteString.Lazy
as
BS
import
qualified
Data.ByteString.Lazy
as
BS
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
import
Data.Text.Encoding
as
T
import
Network.HTTP.Conduit
import
Network.HTTP.Conduit
import
Model.URL
import
Model.URL
import
Utils.Either
(
mapLeft
)
import
Utils.Either
(
mapLeft
)
get
::
URL
->
IO
(
Either
Text
Text
)
get
::
(
ByteString
->
Text
)
->
URL
->
IO
(
Either
Text
Text
)
get
url
=
mapLeft
(
T
.
pack
.
show
)
<$>
(
try
(
unsafeGetPag
e
url
)
::
IO
(
Either
SomeException
Text
))
get
decode
url
=
mapLeft
(
T
.
pack
.
show
)
<$>
(
try
(
unsafeGetPage
decod
e
url
)
::
IO
(
Either
SomeException
Text
))
unsafeGetPage
::
URL
->
IO
Text
unsafeGetPage
::
(
ByteString
->
Text
)
->
URL
->
IO
Text
unsafeGetPage
url
=
(
T
.
decodeLatin1
.
BS
.
toStrict
)
<$>
simpleHttp
(
T
.
unpack
url
)
unsafeGetPage
decode
url
=
(
decode
.
BS
.
toStrict
)
<$>
simpleHttp
(
T
.
unpack
url
)
src/parser/haskell/Parser/Utils.hs
View file @
96bbdbbe
...
@@ -11,7 +11,6 @@ import Data.List (find, findIndex)
...
@@ -11,7 +11,6 @@ import Data.List (find, findIndex)
import
Data.Maybe
(
catMaybes
,
listToMaybe
)
import
Data.Maybe
(
catMaybes
,
listToMaybe
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
import
Text.HTML.TagSoup
import
Text.HTML.TagSoup
getTagsBefore
::
Text
->
[
Tag
Text
]
->
[
Tag
Text
]
getTagsBefore
::
Text
->
[
Tag
Text
]
->
[
Tag
Text
]
...
...
src/test/haskell/Main.hs
View file @
96bbdbbe
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment