5
\$\begingroup\$

I've been learning some Haskell as an amateur (to be precise: I started programming with this language, and it has been a year or less since I started seriously). So far, I have realised only small projects and find myself unable to judge my code (quality, style, ideas, ...)

For example, do you have some suggestion about this small module?

{- cabal:
     build-depends: base, extra, scalpel, parsec
-}

module LibraryScraper where

import Data.Either (fromRight)
import Data.List.Extra (trim)
import Text.HTML.Scalpel
import Text.Parsec
import Text.Parsec.String

--
-- DESCRIPTION
--
-- This library provides a scraper for retrieving some information about
-- the public libraries in Milan (https://milano.biblioteche.it/). The
-- information we care here are: for each day say when they open and when
-- they close or if they are closed for the entire day.
--

-- The libraries supported here.
data Library = Accursio
             | Affori
             | CassinaAnna
             | DerganoBovisa
             | QuartoOggiaro
             | Villapizzone
  deriving (Eq, Show)

-- Assign to each library the homepage url, according to the association
-- list below.
--
-- TODO: The list is to be updated, as the type above.
--
libraryURL :: Library -> Maybe URL
libraryURL name = lookup name libraryURLs

libraryURLs :: [(Library, URL)]
libraryURLs =
  map (fmap wrap)
    [ (Accursio     , "accursio")
    , (Affori       , "affori")
    , (CassinaAnna  , "cassinaanna")
    , (DerganoBovisa, "dergano")
    , (QuartoOggiaro, "quartooggiaro")
    , (Villapizzone , "villapizzone")
    ]
  where
    wrap :: String -> URL
    wrap s = "https://milano.biblioteche.it/library/" ++ s ++ "/timetable/"

-- A date is just a string. For example: "Fri 02 August".
type Date = String

-- The library status.
data Status = Open String String
            -- if open, the interval for which is open
            | Closed
            -- closed the whole day
            | Unknown
            -- who knows? (for parsing purposes see below)
  deriving (Show)

type LibraryCalendar = [(Date, Status)]

-- Provided a library, visit the corresponding web page
--   https://milano.biblioteche.it/library/.../timetable/
-- and return the calendar of the openings you can scrape.
getLibraryCalendar :: Library -> IO (Maybe LibraryCalendar)
getLibraryCalendar name =
  maybe (return Nothing) calendarScraper (libraryURL name)

calendarScraper :: URL -> IO (Maybe LibraryCalendar)
calendarScraper url =
  scrapeURL url $
    chroot (TagString "table" @: [hasClass "library-timetable"]) $
      chroots (TagString "tr" @: []) $ do
        day:interval:_ <- texts $ TagString "td" @: []
        return (day, parseStatus $ trim interval)

-- If the string is "Chiusa" then give Closed, if the string has the form
-- "hh1:mm1 - hh2:mm2" then output Open "hh1:mm1" "hh2:mm2". Unknown is for
-- any other string.
parseStatus :: String -> Status
parseStatus = fromRight Unknown . parse parser ""
  where
    parser :: Parser Status
    parser = try (string "Chiusa" >> return Closed)
         <|> try (Open <$> (hour <* string " - ") <*> hour)
         <?> "\"Chiusa\" or \"hh:mm - hh:mm\""
    hour :: Parser String
    hour = do
      hh <- count 2 digit
      _  <- char ':'
      mm <- count 2 digit
      return $ hh ++ ':' : mm
```
\$\endgroup\$

1 Answer 1

4
\$\begingroup\$

This is quite decent!

Things I would want to change:

  • The way you're representing Libraries is odd, smelly, and generally frowned upon. If you were going to have an enum data Library = Accursio | A..., then instead of libraryURLs :: [(Library, URL)] you should just write
_wrapURL :: String -> URL
_wrapURL s = "https://milano.biblioteche.it/library/" ++ s ++ "/timetable/"

libraryURL :: Library -> URL
libraryURL Accursio = _wrapURL "accursio"
libraryURL A...

but don't do that. The above already looks like it'd be better with record syntax, but even ignoring that, as written you have to change the type declaration (and any place that uses it!) any time the set of existing libraries changes. Instead try

data Library = Library { name :: String
                       , url :: URL
                       }
  deriving (Show, Read)

-- The libraries supported here.
libraries :: [Library]
libraries = [Library n $ wrap u | (n, u) <- libs]
  where libs = [ ("Accursio"     , "accursio")
               , ("Affori"       , "affori")
               , ("CassinaAnna"  , "cassinaanna")
               , ("DerganoBovisa", "dergano")
               , ("QuartoOggiaro", "quartooggiaro")
               , ("Villapizzone ", "villapizzone")
               ]
        wrap s = "https://milano.biblioteche.it/library/" ++ s ++ "/timetable/"
  • Handling dates as strings is usually bad, but since you're not doing anything with them, this is fine. You gave them an alias, which is great! That said, newtype would do more to prevent mistakes. And do the same for the times-of-day.
newtype Date = Date {dateStr :: String} deriving (Show)
newtype Time = Time {timeStr :: String} deriving (Show)
  • In parseStatus, it's concerning that you're throwing away the error message. Consider just capturing whatever's there as a field of Unknown, and you can print it or not when the time comes for printing. There is a small problem with this that I'll mention later.
  • Wrapping Date and Time as newtypes has made their instances of Show less friendly. That's ok; Show should generally only be used for debugging. When you deliberately want to look at data, it usually happens that you want to write a custom "pretty print" function.
  • At this point, you need a new entry point, so that you don't have to instantiate a Library object manually. Exactly how to do this depends on how the tool is going to get used, and how you want to handle failure. Here's one option:
import Data.Either (fromRight)
import Data.List (find)
import Data.List.Extra (trim)
import GHC.IO.Handle (hPutStr)
import GHC.IO.StdHandles (stderr)
import Text.HTML.Scalpel
import Text.Parsec
import Text.Parsec.String

data Library = Library { name :: String
                       , url :: URL
                       } deriving (Show, Read)

-- The libraries supported here.
libraries :: [Library]
libraries = [Library n $ wrap u | (n, u) <- libs]
  where libs = [ ("Accursio"     , "accursio")
               , ("Affori"       , "affori")
               , ("CassinaAnna"  , "cassinaanna")
               , ("DerganoBovisa", "dergano")
               , ("QuartoOggiaro", "quartooggiaro")
               , ("Villapizzone ", "villapizzone")
               ]
        wrap s = "https://milano.biblioteche.it/library/" ++ s ++ "/timetable/"

lookupL :: [Library] -> String -> Maybe Library
lookupL libs n = find ((== n) . name) libs

-- A date is just a string. For example: "Fri 02 August".
newtype Date = Date {dateStr :: String} deriving (Show)
newtype Time = Time {timeStr :: String} deriving (Show)

data Status = Open Time Time
            | Closed
            | Unknown String
  deriving (Show)

type LibraryCalendar = [(Date, Status)]

pretty :: LibraryCalendar -> String
pretty = unlines . (prt <$>)
  where prt (Date{dateStr=date}, Open Time{timeStr=opens} Time{timeStr=closes}) =
                date ++ ":  " ++ opens ++ " - " ++ closes
        prt (Date{dateStr=date}, Closed) = "Closed"
        prt (Date{dateStr=date}, Unknown cause) = "Unparseable: " ++ cause

-- The "main" entry point
getLibraryCalendar :: String -> IO ()
getLibraryCalendar libName = do lib <- maybe notFound pure $ libraries `lookupL` libName
                                mlc <- calendarScraper lib
                                maybe (networkError lib) (putStrLn . pretty) mlc
  where notFound = ioError $ userError $
                     "Unknown library \"" ++ libName ++ "\".\n"
                     ++ "Known libraries are " ++ show (name <$> libraries)
        networkError (Library{url=url}) =
            hPutStr stderr $ "Failed to parse any calendar table from " ++ url ++ ".\n"

calendarScraper :: Library -> IO (Maybe LibraryCalendar)
calendarScraper (Library{url=url}) =
  scrapeURL url $
    chroot (TagString "table" @: [hasClass "library-timetable"]) $
      chroots (TagString "tr" @: []) $ do
        day:interval:_ <- texts $ TagString "td" @: []
        return (Date day, parseStatus $ trim interval)

-- If the string is "Chiusa" then give Closed, if the string has the form
-- "hh1:mm1 - hh2:mm2" then output Open "hh1:mm1" "hh2:mm2". Unknown is for
-- any other string.
parseStatus :: String -> Status
parseStatus = either (Unknown . show) id . parse parser ""
  where
    parser :: Parser Status
    parser = try (string "Chiusa" >> return Closed)
         <|> try (Open <$> (hour <* string " - ") <*> hour)
         <|> Unknown <$> manyTill anyToken eof
    hour :: Parser Time
    hour = do
      hh <- count 2 digit
      _  <- char ':'
      mm <- count 2 digit
      return . Time $ hh ++ ':' : mm

I guess there are two things I want to point out about the above code:

  1. Each of the "failure modes" (unknown library, not connected to the internet, can't find the calendar in the scraped page, can't parse the calendar) is distinguishable to the user, and the failure tries to help the user fix their problem. The small problem I mentioned earlier is that I'm explicitly capturing unparsable strings and printing them for troubleshooting, but it's still theoretically possible that a parse-error could arise, in which case the error message (which is a different kind of data than the contents of an unexpected string) will get saved into that same Unknown field.
  2. As much as practical, collapsing away failure modes happens in the top-level IO function.
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.