follow (empty) → 0.1.0.0

raw patch · 38 files changed

+2724/−0 lines, 38 filesdep +HandsomeSoupdep +aesondep +basesetup-changed

Dependencies added: HandsomeSoup, aeson, base, bytestring, exceptions, feed, follow, hspec, hxt, req, text, time, transformers, unordered-containers, yaml

Files

• ChangeLog.md +8/−0
• LICENSE +30/−0
• README.md +220/−0
• Setup.hs +2/−0
• app/PocketAuth.hs +26/−0
• follow.cabal +131/−0
• src/Data/Time/Follow.hs +40/−0
• src/Follow.hs +65/−0
• src/Follow/Digesters/Pocket.hs +56/−0
• src/Follow/Digesters/Pocket/Auth.hs +113/−0
• src/Follow/Digesters/SimpleText.hs +65/−0
• src/Follow/Fetchers/Feed.hs +26/−0
• src/Follow/Fetchers/Feed/Internal.hs +49/−0
• src/Follow/Fetchers/WebScraping.hs +69/−0
• src/Follow/Fetchers/WebScraping/Internal.hs +125/−0
• src/Follow/Middlewares/Decode.hs +57/−0
• src/Follow/Middlewares/Filter.hs +38/−0
• src/Follow/Middlewares/Filter/Internal.hs +84/−0
• src/Follow/Middlewares/Sort.hs +40/−0
• src/Follow/Parser.hs +406/−0
• src/Follow/Types.hs +70/−0
• src/HTTP/Follow.hs +47/−0
• test/Data/Time/FollowSpec.hs +43/−0
• test/Fixtures/rss.xml +28/−0
• test/Fixtures/webscraping.html +27/−0
• test/Follow/Digesters/SimpleTextSpec.hs +42/−0
• test/Follow/Fetchers/Feed/InternalSpec.hs +41/−0
• test/Follow/Fetchers/FeedSpec.hs +29/−0
• test/Follow/Fetchers/WebScraping/InternalSpec.hs +49/−0
• test/Follow/Fetchers/WebScrapingSpec.hs +28/−0
• test/Follow/Middlewares/Filter/InternalSpec.hs +111/−0
• test/Follow/Middlewares/FilterSpec.hs +18/−0
• test/Follow/Middlewares/SortSpec.hs +18/−0
• test/Follow/ParserSpec.hs +352/−0
• test/FollowSpec.hs +91/−0
• test/Helpers/EndPointFixtures.hs +28/−0
• test/Helpers/Factories.hs +51/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,8 @@+# Change Log+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/) +and this project adheres to [Semantic Versioning](http://semver.org/).++## [0.0.1] - 2018-09-14+- Initial release

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,220 @@+# Follow++`Follow` is a Haskell library to build recipes which allow you to+follow the content published about any subject you are interested.++Here bellow you have a quick tutorial you can follow.  Just run the+snippets of code in the repl.++```haskell+:set -XOverloadedStrings+import Follow+import Data.Time (LocalTime)+import Control.Monad (join)+import qualified Data.Text.IO as T (writeFile)+import Data.Yaml (decodeFileThrough)+```++## Subject++A subject is just a bunch of information about what is being+followed. It consists of a title, a description and a list of tags,++```haskell+haskell =+  Subject+    { sTitle = "Haskell"+    , sDescription = "Some resources about Haskell"+    , sTags = ["haskell", "programming"]+    }+```++## Directory++A directory is just a subject and a list of entries.++An entry is an item meant to contain an URI with content relative to+the associated subject along with associated information.++```haskell+manualDirectory =+  Directory+    { dSubject = haskell+    , dEntries =+        [ Entry+            { eURI =+                Just "https://bartoszmilewski.com/2013/06/19/basics-of-haskell/"+            , eGUID = Just "basics-of-haskell"+            , eTitle = Just "Basics of Haskell"+            , eDescription = Just "Introductory material for Haskell"+            , eAuthor = Just "Bartosz Milewski"+            , ePublishDate = Just (read "2013-06-19 14:14:00" :: LocalTime)+            }+        ]+    }+```++## Fetchers++Of course, building list of entries by hand is not very+useful. Fetchers are functions which usually reach the outside world+to return a list of entries and which can throw an error.++Any fetcher can be used, but `Follow` tries to ship with common+ones. Right now there are two fetchers available:++- [Feed](src/Follow/Fetchers/Feed.hs): Take entries from a RSS or Atom feed.+- [Web Scraping](src/Follow/Fetchers/WebScraping.hs): Take entries+  scraping the HTML of a web page.++The function `directoryFromFetched` can be used to glue a subject with+some fetched content:++```haskell+import qualified Follow.Fetchers.Feed as Feed++directory =+  directoryFromFetched (Feed.fetch "https://bartoszmilewski.com/feed/") haskell+```++## Middlewares++Fetched content may need some further processing in order to fit what+is actually desired. A middleware is a function which transforms a+directory into another directory, allowing us to do any kind of+transformation.++The aim of `Follow` is to provide some common middlewares. For now,+there are these ones:++- [Filter](src/Follow/Middlewares/Filter.hs): Filter entries according+  some predicate.+- [Sort](src/Follow/Middlewares/Sort.hs): Sort entries.+- [Decode](src/Follow/Middlewares/Decode.hs): Decodes entries from+  UTF8 or other encodings.++```haskell+import qualified Follow.Middlewares.Sort as Sort++sortedDirectory =+  Sort.apply (Sort.byGetter eTitle) <$> directory+```++## Digesters++Once you have your distillate content, you need some way to consume+it. A `Digester` is a function which transforms a directory into+anything that can be consumed by an end user.++As before, `Follow` aims to provide useful ones out of the box. Right+now the following are available:++- [Simple Text](src/Follow/Digesters/SimpleText.hs): Simple textual+  representation of the directory.+- [Pocket](src/Follow/Digesters/Pocket.hs): Send fetched links to+  [Pocket](https://getpocket.com).++```haskell+import qualified Follow.Digesters.SimpleText as SimpleText++content = SimpleText.digest <$> sortedDirectory+```++Now, for example, you are ready to save the content to a file:++```haskell+join $ T.writeFile "/your/path/haskell.txt" <$> content+```++## Recipes: Combining sources and middlewares++Content is not limited to be fetched from a single source. Instead, a+directory can be built merging the entries fetched from different+sources. Also, the stack of middlewares to be applied to each source can be+given in a single shot.++This whole process specification is called a `Recipe`, and it contains+all the information needed to follow a subject.++To build the recipe you need to provide three fields:++- The subject being followed.+- A list of two field tuples where:+  - First field is some fetched content.+  - Second field is a list of middlewares to apply to the fetched content in the first field.+- A list of middlewares to apply to the directory resulted after applying the list of fetched/middlewares.++```haskell+haskellRecipe =+  Recipe+    { rSubject = haskell+    , rSteps =+        [ ( Feed.fetch "https://bartoszmilewski.com/feed/"+          , [Sort.apply (Sort.byGetter eTitle)])+        , (Feed.fetch "https://planet.haskell.org/rss20.xml", [])+        ]+    , rMiddlewares = []+    }+```++You can combine the function `directoryFromRecipe` and some digester+to quickly consume a recipe:++```haskell+SimpleText.digest <$> directoryFromRecipe haskellRecipe+```++## Collecting recipes++One nice thing in Follow is that you don't need to create the recipes+programmatically each time you need them. Instead, you can store them+in a [YAML](https://en.wikipedia.org/wiki/YAML) file and just parse+them when you need.++For example, the previous recipe can be represented in a file+`recipe.yml` as the following:++```yaml+subject:+  title: Haskell+  description: Some resources about Haskell+  tags: [haskell, programming]+steps:+  -+    - type: feed+      options:+        url: "https://bartoszmilewski.com/feed/"+    -+      - type: sort+        options:+          function:+            type: by_field+            options:+              field: title+middlewares: []+```++You can use now decode functions in+[`Data.Yaml`](https://hackage.haskell.org/package/yaml) to get the+recipe back:++```haskell+recipe' <- decodeFileThrow "/your/path/recipe.yml" :: IO (Recipe IO)+directory' = directoryFromRecipe recipe'+```++Look at [`src/Follow/Parser.hs`](src/Follow/Parser.hs) for details about+encoding each kind of fetcher and middleware.++## Contributing++Bug reports and pull requests are welcome on GitHub at+https://github.com/waiting-for-dev/follow. This project is+intended to be a safe, welcoming space for collaboration, and+contributors are expected to adhere to the [Contributor+Covenant](http://contributor-covenant.org) code of conduct.++## License++The package is available as open source under the terms of the [GNU+LGPLv3 License](http://opensource.org/licenses/LGPL-3.0).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+{-|+Description: Executable to authorize Follow into Pocket.++"Follow.Digesters.Pocket" needs the user to grant privileges to our+app so that we can add articles to her account.++Run it with: @stack exec follow_pocket_auth@.++After running it, an access token is printed to stdout. This can be+used to run the pocket digester (see `Follow.Digesters.Pocket.digest`.+-}+module Main where++import           Data.Text               (Text)+import qualified Data.Text               as T (concat, unpack)+import           Follow.Digesters.Pocket++main :: IO ()+main = do+  (rToken, url) <- requestTokenStep+  putStrLn "Please, press ENTER after visiting:"+  putStrLn $ T.unpack url+  getChar+  aToken <- accessTokenStep rToken+  putStrLn "Your access token is:"+  putStrLn $ T.unpack aToken

@@ -0,0 +1,131 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0f00896fbd211fccddea5848a59a319724267d6c8630594170bac97733a1d85c++name:           follow+version:        0.1.0.0+synopsis:       Haskell library to follow content published on any subject.+description:    Please, see the README on GitHub at <https://github.com/waiting-for-dev/follow#readme>+category:       Web+homepage:       https://github.com/waiting-for-dev/follow#readme+bug-reports:    https://github.com/waiting-for-dev/follow/issues+author:         Marc Busqué Pérez+maintainer:     marc@lamarciana.com+copyright:      2018 Marc Busqué Pérez+license:        LGPL-3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md+data-files:+    test/Fixtures/rss.xml+    test/Fixtures/webscraping.html++source-repository head+  type: git+  location: https://github.com/waiting-for-dev/follow++library+  exposed-modules:+      Data.Time.Follow+      Follow+      Follow.Digesters.Pocket+      Follow.Digesters.Pocket.Auth+      Follow.Digesters.SimpleText+      Follow.Fetchers.Feed+      Follow.Fetchers.Feed.Internal+      Follow.Fetchers.WebScraping+      Follow.Fetchers.WebScraping.Internal+      Follow.Middlewares.Decode+      Follow.Middlewares.Filter+      Follow.Middlewares.Filter.Internal+      Follow.Middlewares.Sort+      Follow.Parser+      Follow.Types+      HTTP.Follow+  other-modules:+      Paths_follow+  hs-source-dirs:+      src+  build-depends:+      HandsomeSoup+    , aeson+    , base >=4.7 && <5+    , bytestring+    , exceptions+    , feed+    , hxt+    , req+    , text+    , time+    , transformers+    , unordered-containers+    , yaml+  default-language: Haskell2010++executable follow_pocket_auth+  main-is: PocketAuth.hs+  other-modules:+      Paths_follow+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HandsomeSoup+    , aeson+    , base >=4.7 && <5+    , bytestring+    , exceptions+    , feed+    , follow+    , hxt+    , req+    , text+    , time+    , transformers+    , unordered-containers+    , yaml+  default-language: Haskell2010++test-suite follow-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.Time.FollowSpec+      Follow.Digesters.SimpleTextSpec+      Follow.Fetchers.Feed.InternalSpec+      Follow.Fetchers.FeedSpec+      Follow.Fetchers.WebScraping.InternalSpec+      Follow.Fetchers.WebScrapingSpec+      Follow.Middlewares.Filter.InternalSpec+      Follow.Middlewares.FilterSpec+      Follow.Middlewares.SortSpec+      Follow.ParserSpec+      FollowSpec+      Helpers.EndPointFixtures+      Helpers.Factories+      Paths_follow+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HandsomeSoup+    , aeson+    , base >=4.7 && <5+    , bytestring+    , exceptions+    , feed+    , follow+    , hspec+    , hxt+    , req+    , text+    , time+    , transformers+    , unordered-containers+    , yaml+  default-language: Haskell2010

@@ -0,0 +1,40 @@+{- |+Description: Date and time utilities used in the library.++This module exposes functions related with date and time which are+used in other parts of the library.+-}+module Data.Time.Follow+  ( parseTimeGuess+  ) where++import           Control.Applicative ((<|>))+import           Data.Text           (Text)+import qualified Data.Text           as T (unpack)+import           Data.Time           (ParseTime, defaultTimeLocale, formatTime,+                                      iso8601DateFormat, parseTimeM,+                                      rfc822DateFormat)++-- | Parses a date guessing from a list of accepted formats. Right now+-- these are:+--   - iso8601: 2018-01-01+--   - iso8601 with time: 2018-01-01T12:35+--   - iso8601 with time and timezone: 2018-01-01T12:35+0100+--   - iso8601 with fractions of seconds: 2018-01-01T12:35.001000+--   - iso8601 with fractions of seconds and timezone:+--   2018-01-01T12:35.001000+0100+--   - rfc822: Mon, 01 Jan 2018 12:35:00 +0100+--   - epoch: 1514810100+parseTimeGuess :: ParseTime t => Text -> Maybe t+parseTimeGuess string =+  let formats =+        [ iso8601DateFormat Nothing+        , iso8601DateFormat $ Just "%H:%M:%S%Z"+        , iso8601DateFormat $ Just "%H:%M:%S%Q%Z"+        , rfc822DateFormat+        , "%s"+        ]+      results = parseTime' (T.unpack string) <$> formats+   in foldl1 (<|>) results+  where+    parseTime' = flip $ parseTimeM True defaultTimeLocale

@@ -0,0 +1,65 @@+{- |+Description: Defines and reexports application level components.++Read the [README](https://github.com/waiting-for-dev/follow#readme)+file for a description of `Follow` application.++Importing this module makes all application scope components+available. In addition, you probably will need to import individual+fetchers, middlewares and digesters.+-}+module Follow+  ( Recipe(..)+  , Subject(..)+  , Entry(..)+  , Fetched+  , Directory(..)+  , Step+  , Middleware+  , Digester+  , directoryFromRecipe+  , directoryFromFetched+  , applyMiddlewares+  , applySteps+  , emptyDirectory+  , mergeEntries+  ) where++import           Control.Monad.Catch (MonadThrow)+import           Data.Foldable       (foldlM)+import           Data.List           (nub)+import           Follow.Types        (Digester, Directory (..), Entry (..),+                                      Fetched, Middleware, Recipe (..), Step,+                                      Subject (..))++-- | Builds a directory from the specification stored in a recipe+directoryFromRecipe :: MonadThrow m => Recipe m -> m Directory+directoryFromRecipe recipe =+  let Recipe {rSubject = subject, rSteps = steps, rMiddlewares = middlewares} =+        recipe+   in applyMiddlewares middlewares <$> applySteps (emptyDirectory subject) steps++-- | Helper to build a directory from a subject and a list of fetched+-- entries.+directoryFromFetched :: MonadThrow m => m [Entry] -> Subject -> m Directory+directoryFromFetched fetched header = Directory header <$> fetched++-- | Applies, from left to right, given middlewares to the directory.+applyMiddlewares :: [Middleware] -> Directory -> Directory+applyMiddlewares = flip $ foldl (flip ($))++-- | Applies, from left to right, a list of steps to given directory.+applySteps :: MonadThrow m => Directory -> [Step m] -> m Directory+applySteps = foldlM applyStep+  where+    applyStep directory (fetched, middlewares) =+      applyMiddlewares middlewares . mergeEntries directory <$> fetched++-- | Creates a directory with given subject and no entries.+emptyDirectory :: Subject -> Directory+emptyDirectory s = Directory {dSubject = s, dEntries = mempty}++-- | Merges a list of entries into a Directory, keeping only first+-- appearance of duplicates.+mergeEntries :: Directory -> [Entry] -> Directory+mergeEntries d e = d {dEntries = nub $ dEntries d ++ e}

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Description: Send entries in the directory to Pocket.++This module contains the definition of a digester which sends all the+entries within the directory to Pocket (https://getpocket.com)+application.++In order to be able to send the information to Pocket, first the user+needs to authorize Follow application. For this reason, this module+also exports functions which deal with the authentication+process. However, as a user, the most straighforward way to+authenticate is to execute:++@+stack exec follow_pocket_auth+@++After the process is finished, the previous command will print an+access token which needs to be provided to the `digest` method.++-}+module Follow.Digesters.Pocket+  ( requestTokenStep+  , accessTokenStep+  , digest+  ) where++import           Control.Monad.Catch          (MonadThrow)+import           Data.Aeson                   (Value, object, (.=))+import qualified Data.HashMap.Strict          as HS+import           Data.Maybe                   (fromJust, isJust)+import           Data.Text                    (Text)+import           Follow.Digesters.Pocket.Auth+import           Follow.Types                 (Digester, Directory (..),+                                               Entry (..))+import           Network.HTTP.Req             (MonadHttp, https, (/:))++digest ::+     (MonadHttp m, MonadThrow m) => Text -> Digester (m (HS.HashMap Text Value))+digest token directory = jsonPostResponseBody url body jsonHeaders+  where+    url = https "getpocket.com" /: "v3" /: "send"+    body =+      object+        [ "consumer_key" .= consumerKey+        , "access_token" .= token+        , "actions" .=+          (entryToAction <$> filter (isJust . eURI) (dEntries directory))+        ]+    entryToAction entry =+      object+        [ "action" .= ("add" :: Text)+        , "url" .= ((fromJust $ eURI entry) :: Text)+        ]

@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Description: Authentication logic for Pocket.++This module contains functions to deal with the authentication process+of Pocket. Read https://getpocket.com/developer/docs/authentication to+have all the details of this process.++A user friendly method to interact with the authentication process is+through the command:++@+stack exec follow_pocket_auth+@+-}+module Follow.Digesters.Pocket.Auth+  ( requestTokenStep+  , accessTokenStep+  , jsonPostResponseBody+  , jsonHeaders+  , consumerKey+  ) where++import           Control.Monad.Catch (Exception, MonadThrow, throwM)+import           Data.Aeson          (ToJSON, Value (..), object, (.=))+import qualified Data.HashMap.Strict as HS+import           Data.Text           (Text)+import qualified Data.Text           as T (concat)+import           GHC.Generics        (Generic)+import           HTTP.Follow+import           Network.HTTP.Req    (MonadHttp, Option, POST (..),+                                      ReqBodyJson (..), Url, header, https,+                                      jsonResponse, req, responseBody, (/:))++-- | Errors authenticating in pocket API.+data PocketError+  = PocketTokenNotFound+  | PocketTokenDecodingError+  deriving (Eq, Show, Exception)++-- | Consumer key for the Follow application in Pocket.+consumerKey :: Text+consumerKey = "80296-6e350545b4382d839b3aa5df"++-- | First auth step. Asks Pocket for a request token. It returns the+-- token itself and the URL that the user must visit in order to grant+-- access before proceeding to the second step.+requestTokenStep :: (MonadThrow m, MonadHttp m) => m (Text, Text)+requestTokenStep = do+  token <- getRequestToken+  processTokenStep token $ \token ->+    ( token+    , T.concat+        [ "https://getpocket.com/auth/authorize?request_token="+        , token+        , "&redirect_uri="+        , "https://getpocket.com"+        ])++-- | Second auth step. Once a user has granted permission to Follow,+-- it exchanges a request token for an access token. The access token+-- is what it needs to be used in any other Pocket API call.+accessTokenStep :: (MonadHttp m, MonadThrow m) => Text -> m Text+accessTokenStep rToken = do+  token <- getAccessToken rToken+  processTokenStep token id++processTokenStep ::+     (MonadHttp m, MonadThrow m) => Maybe Value -> (Text -> a) -> m a+processTokenStep token f =+  case token of+    Nothing             -> throwM PocketTokenNotFound+    Just (String token) -> return $ f token+    Just _              -> throwM PocketTokenDecodingError++-- | Gets the JSON response body of a POST request.+jsonPostResponseBody ::+     (ToJSON b, MonadHttp m, MonadThrow m)+  => Url scheme+  -> b+  -> Option scheme+  -> m (HS.HashMap Text Value)+jsonPostResponseBody url body options =+  responseBody <$> req POST url (ReqBodyJson body) jsonResponse options++-- | Pocket expected headers for a JSON interaction.+jsonHeaders =+  header "Content-Type" "application/json; charset=UTF-8" <>+  header "X-Accept" "application/json"++getRequestToken :: (MonadHttp m, MonadThrow m) => m (Maybe Value)+getRequestToken =+  parseValue "code" <$> jsonPostResponseBody url body jsonHeaders+  where+    url = https "getpocket.com" /: "v3" /: "oauth" /: "request"+    body =+      object+        [ "consumer_key" .= String consumerKey+        , "redirect_uri" .= String "https://getpocket.com"+        ]++getAccessToken :: (MonadHttp m, MonadThrow m) => Text -> m (Maybe Value)+getAccessToken rToken =+  parseValue "access_token" <$> jsonPostResponseBody url body jsonHeaders+  where+    url = https "getpocket.com" /: "v3" /: "oauth" /: "authorize"+    body = object ["consumer_key" .= String consumerKey, "code" .= rToken]++parseValue :: Text -> HS.HashMap Text Value -> Maybe Value+parseValue = HS.lookup

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Description: Digests a subject into a textual representation.++This module defines a digester which justs takes the directory and+transforms it into a text with a minimal format.+-}+module Follow.Digesters.SimpleText+  ( digest+  ) where++import           Data.Maybe   (fromMaybe)+import           Data.Text    (Text)+import qualified Data.Text    as T (concat, intercalate, pack, replicate)+import           Follow.Types (Digester, Directory (..), Entry (..),+                               Subject (..))++-- | The digester strategy to transform a directory into a simple text+-- representation.+digest :: Digester Text+digest directory =+  let header = dSubject directory+      headerTitle = sTitle header+      headerDescription = sDescription header+      headerTags = sTags header+      entries = dEntries directory+   in T.intercalate+        emptyLine+        [ headerTitle+        , headerDescription+        , T.intercalate "," headerTags+        , headerSeparator+        , digestEntries entries+        ]+  where+    headerSeparator :: Text+    headerSeparator = T.replicate 80 "#"++digestEntries :: [Entry] -> Text+digestEntries entries = T.intercalate entrySeparator $ map digestEntry entries+  where+    entrySeparator :: Text+    entrySeparator = T.concat ["\n", T.replicate 80 "-", "\n"]+    digestEntryItem :: Maybe Text -> Text+    digestEntryItem = fromMaybe ""+    digestEntry :: Entry -> Text+    digestEntry entry =+      let entryURI = eURI entry+          entryTitle = eTitle entry+          entryDescription = eDescription entry+          entryAuthor = eAuthor entry+          entryPublishDate = ePublishDate entry+       in T.intercalate+            emptyLine+            (digestEntryItem <$>+             [ entryURI+             , entryTitle+             , T.pack . show <$> entryPublishDate+             , entryDescription+             , entryAuthor+             ])++emptyLine :: Text+emptyLine = "\n\n\n"

@@ -0,0 +1,26 @@+{-|+Description: Defines a fetcher strategy to take entries from a RSS or+             Atom feed.++This module is the namespace to define a fetcher strategy which takes+entries from a URL pointing to a RSS or Atom feed.+-}+module Follow.Fetchers.Feed+  ( fetch+  , FeedError(..)+  ) where++import           Control.Monad.Catch           (MonadThrow)+import qualified Data.ByteString               as BS (ByteString)+import           Follow.Fetchers.Feed.Internal+import           Follow.Types                  (Fetched)+import           HTTP.Follow                   (getResponseBody, parseUrl)+import qualified Network.HTTP.Req              as R (MonadHttp)++-- | The fetcher strategy.+fetch :: (R.MonadHttp m, MonadThrow m) => BS.ByteString -> Fetched m+fetch url = do+  url' <- parseUrl url+  response <- getResponseBody url'+  feed <- parseFeed response+  return $ feedToEntries feed

@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveAnyClass #-}++{-|+Description: Wiring for the feed fecther strategy.++This module defains low level helper functions to be used by the feed+fetcher strategy.+-}+module Follow.Fetchers.Feed.Internal+  ( feedToEntries+  , parseFeed+  , FeedError(..)+  ) where++import           Control.Monad.Catch  (Exception, MonadThrow, throwM)+import qualified Data.ByteString.Lazy as BL (ByteString)+import           Data.Time            (UTCTime)+import           Data.Time.Follow     (parseTimeGuess)+import           Follow.Types         (Entry (..))+import           Text.Feed.Import     as F (parseFeedSource)+import           Text.Feed.Query      as F (feedItems, getItemAuthor,+                                            getItemDescription, getItemId,+                                            getItemLink,+                                            getItemPublishDateString,+                                            getItemTitle)+import           Text.Feed.Types      as F (Feed, Item)++-- | Errors when parsing a feed+data FeedError =+  FeedWrongFormat+  deriving (Show, Eq, Exception)++-- | Parses a feed type from a textual representation.+parseFeed :: MonadThrow m => BL.ByteString -> m F.Feed+parseFeed body = maybe (throwM FeedWrongFormat) return (F.parseFeedSource body)++-- | Transforms a feed to a list of entries.+feedToEntries :: F.Feed -> [Entry]+feedToEntries feed = itemToEntry <$> F.feedItems feed+  where+    itemToEntry :: F.Item -> Entry+    itemToEntry item =+      Entry+        (F.getItemLink item)+        (snd <$> F.getItemId item)+        (F.getItemTitle item)+        (F.getItemDescription item)+        (F.getItemAuthor item)+        (parseTimeGuess =<< F.getItemPublishDateString item)

@@ -0,0 +1,69 @@+{-|+Description: Fetcher strategy to scrap info from an HTML URI.++This module is the namespace to define a fetcher strategy which+generates entries scraping the contents requested to an HTML URI.++A `Selector` must be given in order to know from where the information+for each entry field should be taken.++Be aware that scraping an HTML page has very few consistency+warantee. So, depending on the page structure and the selector you+give, you could end up with 5 URIs, 4 titles and 6 descriptions. Keep+in mind that the leading and limiting asset are the URIs, so in the+previous scenario one `Nothing` title would be added and one+description would be discarded.++Here it is an example:++@+import Follow+import Follow.Fetchers.WebScraping++selector :: Selector+selector = Selector {+    selURI = Just $ Attr ".title a" "href"+  , selGUID = Just $ Attr ".title a" "href"+  , selTitle = Just $ InnerText ".title a"+  , selDescription = Just $ InnerText ".description"+  , selAuthor = Just $ InnerText ".author"+  , selPublishDate = Nothing+}++result :: IO [Entry]+result = fetch ("http://an_url.com", selector)+@+-}+module Follow.Fetchers.WebScraping+  ( fetch+  , Selector(..)+  , SelectorItem(..)+  , CSSSelector+  , HTMLAttribute+  ) where++import           Control.Monad.Catch                  (MonadThrow)+import           Control.Monad.IO.Class               (MonadIO, liftIO)+import qualified Data.ByteString                      as BS (ByteString)+import qualified Data.ByteString.Lazy                 as BL (ByteString)+import           Data.Text                            (Text)+import           Follow.Fetchers.WebScraping.Internal (CSSSelector,+                                                       HTMLAttribute,+                                                       Selector (..),+                                                       SelectorItem (..),+                                                       htmlToEntries)+import           Follow.Types                         (Fetched)+import           HTTP.Follow                          (getResponseBody,+                                                       parseUrl)+import           Network.HTTP.Req                     (MonadHttp)++-- | Fetches entries from given url using specified selectors.+fetch ::+     (MonadThrow m, MonadIO m, MonadHttp m)+  => BS.ByteString+  -> Selector+  -> Fetched m+fetch url selector = do+  url' <- parseUrl url+  response <- getResponseBody url'+  liftIO $ htmlToEntries response selector

@@ -0,0 +1,125 @@+{-|+Description: Internals for the web scraping fetching strategy.++This module contains the inner wiring for the scraping fetching+strategy.+-}+module Follow.Fetchers.WebScraping.Internal+  ( Selector(..)+  , SelectorItem(..)+  , CSSSelector+  , HTMLAttribute+  , htmlToEntries+  ) where++import           Control.Monad              (join)+import qualified Data.ByteString            as BS (ByteString)+import qualified Data.ByteString.Lazy       as BL (ByteString)+import qualified Data.ByteString.Lazy.Char8 as BL (unpack)+import           Data.List                  (uncons)+import           Data.Text                  (Text)+import qualified Data.Text                  as T (pack, unpack)+import           Data.Time                  (UTCTime)+import           Data.Time.Follow           (parseTimeGuess)+import           Data.Tree.NTree.TypeDefs   (NTree)+import           Follow.Types               (Entry (..))+import           Text.HandsomeSoup          (css, parseHtml, (!))+import           Text.XML.HXT.Core          (IOSArrow, XNode, getChildren,+                                             getText, isText, runX, (>>>))+import           Text.XML.HXT.DOM.TypeDefs  (XmlTree)++-- | Data type with the selectors to use when scraping each `Entry`+-- item.+data Selector = Selector+  { selURI         :: Maybe SelectorItem+  , selGUID        :: Maybe SelectorItem+  , selTitle       :: Maybe SelectorItem+  , selDescription :: Maybe SelectorItem+  , selAuthor      :: Maybe SelectorItem+  , selPublishDate :: Maybe SelectorItem+  } deriving (Eq, Show)++-- | Selector to use when scraping an `Entry` item.+data SelectorItem+  = InnerText CSSSelector -- ^ This selector will take the inner text+  -- immediately descendant of a tag selected with given css selector.+  | Attr CSSSelector+         HTMLAttribute -- ^ This selector will take the value of given+  -- argument in the tag matched by given css selector.+  deriving (Eq, Show)++-- | A CSS2 selector.+type CSSSelector = Text++-- | An HTML attribute name.+type HTMLAttribute = Text++type Doc b = IOSArrow b (NTree XNode)++type SLinks = [Text]++type SGuids = [Text]++type STitles = [Text]++type SDescriptions = [Text]++type SAuthors = [Text]++type SPublishDates = [Text]++-- | Converts a bytestring with HTML content to a list of entries,+-- scraping entry items using given selector. The return type is+-- wrapped within an IO because of the underlying vendor API.+htmlToEntries :: BL.ByteString -> Selector -> IO [Entry]+htmlToEntries html selector = do+  links <- scrap doc (selURI selector)+  guids <- scrap doc (selGUID selector)+  titles <- scrap doc (selTitle selector)+  descriptions <- scrap doc (selDescription selector)+  authors <- scrap doc (selAuthor selector)+  publishDates <- scrap doc (selPublishDate selector)+  return $ entriesFromItems links guids titles descriptions authors publishDates+  where+    doc = parseHtml $ BL.unpack html++entriesFromItems ::+     SLinks+  -> SGuids+  -> STitles+  -> SDescriptions+  -> SAuthors+  -> SPublishDates+  -> [Entry]+entriesFromItems [] _guids _titles _descriptions _authors _publishDates = []+entriesFromItems (u:us) guids titles descriptions authors publishDates =+  let (g, gs) = extract guids id+      (t, ts) = extract titles id+      (d, ds) = extract descriptions id+      (a, as) = extract authors id+      (p, ps) = extract publishDates parseTimeGuess+   in Entry+        { eURI = Just u+        , eGUID = g+        , eTitle = t+        , eDescription = d+        , eAuthor = a+        , ePublishDate = join p+        } :+      entriesFromItems us gs ts ds as ps+  where+    extract :: [a] -> (a -> b) -> (Maybe b, [a])+    extract l f =+      case uncons l of+        Nothing     -> (Nothing, [])+        Just (h, t) -> (Just (f h), t)++scrap :: Doc XmlTree -> Maybe SelectorItem -> IO [Text]+scrap _doc Nothing = return []+scrap doc (Just (InnerText selector)) =+  let items =+        doc >>> css (T.unpack selector) >>> getChildren >>> isText >>> getText+   in fmap T.pack <$> runX items+scrap doc (Just (Attr selector attr)) =+  let items = doc >>> css (T.unpack selector) ! T.unpack attr+   in fmap T.pack <$> runX items

@@ -0,0 +1,57 @@+{-|+Description: Decodes entry fields to some encoding.++Middleware to decode entry fields, usually fetched from some external+source, from a given encoding different to default Latin1.++@+import Follow.Middlewares.Decode++apply UTF8 directory+@+-}+module Follow.Middlewares.Decode+  ( apply+  , Encoding(..)+  ) where++import qualified Data.ByteString.Char8    as BSC (pack)+import qualified Data.Text                as T (unpack)+import           Data.Text.Encoding       (decodeUtf16BEWith, decodeUtf16LEWith,+                                           decodeUtf32BEWith, decodeUtf32LEWith,+                                           decodeUtf8With)+import           Data.Text.Encoding.Error (lenientDecode)+import           Follow.Types             (Directory (..), Entry (..),+                                           Middleware)++-- | Supported encodings.+data Encoding+  = UTF8+  | UTF16LE+  | UTF16BE+  | UTF32LE+  | UTF32BE+  deriving (Eq, Show)++-- | Middleware operation. Give it a `Encoding` and get back the+-- decoded directory.+apply :: Encoding -> Middleware+apply encoding directory =+  directory {dEntries = decodeEntry encoding <$> dEntries directory}++decodeEntry :: Encoding -> Entry -> Entry+decodeEntry encoding entry =+  let d = decodingFunction encoding lenientDecode . BSC.pack . T.unpack+   in entry+        { eURI = d <$> eURI entry+        , eGUID = d <$> eGUID entry+        , eTitle = d <$> eTitle entry+        , eDescription = d <$> eDescription entry+        , eAuthor = d <$> eAuthor entry+        }+  where+    decodingFunction UTF8    = decodeUtf8With+    decodingFunction UTF16LE = decodeUtf16LEWith+    decodingFunction UTF16BE = decodeUtf16BEWith+    decodingFunction UTF32LE = decodeUtf32LEWith+    decodingFunction UTF32BE = decodeUtf32BEWith

@@ -0,0 +1,38 @@+{-|+Description: Middleware to filter entries according to a predicate.++This middleware allows to filter the directory entries according to a+predicate. The predicate is a function @Entry -> Bool@.++Some pre-built predicate builders are also exported. Example:++@+import Follow+import Follow.Middlewares.Filter++-- Suppose we have a `Directory` d++apply (eTitle `equalP` "Some title") d+@++-}+module Follow.Middlewares.Filter+  ( apply+  , Predicate+  , equalP+  , lessP+  , greaterP+  , infixP+  , prefixP+  , suffixP+  , andP+  , orP+  , notP+  ) where++import           Follow.Middlewares.Filter.Internal+import           Follow.Types                       (Directory (..), Middleware)++-- | Middleware to filter a directory according to a given predicate.+apply :: Predicate -> Middleware+apply p directory = directory {dEntries = filter p (dEntries directory)}

@@ -0,0 +1,84 @@+{-|+Description: Predicate builders and combinators to be used in the+             filter middleware.++This module defines some predicate builders and combinators useful to+apply the filter middleware to a directory.++-}+module Follow.Middlewares.Filter.Internal+  ( Predicate+  , equalP+  , lessP+  , greaterP+  , infixP+  , prefixP+  , suffixP+  , andP+  , orP+  , notP+  ) where++import           Data.Maybe   (fromMaybe)+import           Data.Text    (Text)+import qualified Data.Text    as T (isInfixOf, isPrefixOf, isSuffixOf)+import           Follow.Types (Entry, EntryGetter)++-- | Predicate that takes an `Entry` as argument.+type Predicate = Entry -> Bool++-- | Builds a predicate which takes the field returned by the getter+-- and compares with given value for equality. It returns `False` when+-- field is `Nothing`.+equalP :: Eq a => EntryGetter a -> a -> Predicate+equalP = liftP (==)++-- | Builds a predicate which takes the field returned by the getter+-- and compares whether it is less than given value. It returns `False` when+-- field is `Nothing`.+lessP :: Ord a => EntryGetter a -> a -> Predicate+lessP = liftP (<)++-- | Builds a predicate which takes the field returned by the getter+-- and compares whether it is greater than given value. It returns `False` when+-- field is `Nothing`.+greaterP :: Ord a => EntryGetter a -> a -> Predicate+greaterP = liftP (>)++-- | Builds a predicate which takes given value and checks whether it+-- is an infix for the field returned by given getter. It returns `False`+-- when field is `Nothing`.+infixP :: Text -> EntryGetter Text -> Predicate+infixP = flip $ liftP (flip T.isInfixOf)++-- | Builds a predicate which takes given value and checks whether it+-- is a prefix for the field returned by given getter. It returns `False`+-- when field is `Nothing`.+prefixP :: Text -> EntryGetter Text -> Predicate+prefixP = flip $ liftP (flip T.isPrefixOf)++-- | Builds a predicate which takes given value and checks whether it+-- is a suffix for the field returned by given getter. It returns `False`+-- when field is `Nothing`.+suffixP :: Text -> EntryGetter Text -> Predicate+suffixP = flip $ liftP (flip T.isSuffixOf)++-- | Builds a predicate which combines with a logical and given+-- predicates.+andP :: Predicate -> Predicate -> Predicate+andP = liftB (&&)++-- | Builds a predicate which combines with a logical or given+-- predicates.+orP :: Predicate -> Predicate -> Predicate+orP = liftB (||)++-- | Build a predicte which negates the result of given predicate.+notP :: Predicate -> Predicate+notP p entry = not $ p entry++liftP :: (a -> b -> Bool) -> EntryGetter a -> b -> Predicate+liftP p getter x entry = maybe False (`p` x) (getter entry)++liftB :: (Bool -> Bool -> Bool) -> Predicate -> Predicate -> Predicate+liftB f p q entry = p entry `f` q entry

@@ -0,0 +1,40 @@+{-|+Description: Middleware to sort entries according to a function.++This middleware allows to sort the directory entries according to a+comparison function. The comparison function has a type @Entry ->+Entry -> Ordering@.++Some pre-built comparison function builders are also+exported. Example:++@+import Follow+import Follow.Middlewares.Sort++-- Suppose we have a `Directory` d++apply (byGetter eTitle) d+@++-}+module Follow.Middlewares.Sort+  ( apply+  , byGetter+  , ComparisonFunction+  ) where++import           Data.List    (sortBy)+import           Follow.Types (Directory (..), Entry, EntryGetter, Middleware)++-- | Function to compare entries.+type ComparisonFunction = Entry -> Entry -> Ordering++-- | Middleware to sort a directory according to a given comparison function.+apply :: ComparisonFunction -> Middleware+apply f directory = directory {dEntries = sortBy f (dEntries directory)}++-- | Creates a comparison function that sorts by the values returned+-- by a getter+byGetter :: Ord a => EntryGetter a -> ComparisonFunction+byGetter getter e1 e2 = compare (getter e1) (getter e2)

@@ -0,0 +1,406 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-|+Description: Instances to parse Follow types from YAML or JSON.++This module contains `Data.Yaml.FromJSON` instances in order to be+able to parse Follow types up to a `Recipe` from a yaml or json text.++You can use decode functions in "Data.Yaml" in order to do the parsing.++For time fields, any format accepted by+`Data.Time.Follow.parseTimeGuess` is accepted.+-}+module Follow.Parser+  (+  ) where++import           Control.Monad.Catch         (MonadThrow, throwM)+import           Control.Monad.IO.Class      (MonadIO)+import           Data.ByteString             (ByteString)+import           Data.Text                   (Text)+import qualified Data.Text                   as T (unpack)+import qualified Data.Text.Encoding          as T (encodeUtf8)+import           Data.Time                   (LocalTime)+import           Data.Time.Follow            (parseTimeGuess)+import           Data.Yaml+import qualified Follow.Fetchers.Feed        as F.Feed (fetch)+import qualified Follow.Fetchers.WebScraping as F.WebScraping (Selector (..),+                                                               SelectorItem (..),+                                                               fetch)+import qualified Follow.Middlewares.Decode   as M.Decode (Encoding (..), apply)+import qualified Follow.Middlewares.Filter   as M.Filter (Predicate (..), andP,+                                                          apply, equalP,+                                                          greaterP, infixP,+                                                          lessP, notP, orP,+                                                          prefixP, suffixP)+import qualified Follow.Middlewares.Sort     as M.Sort (ComparisonFunction,+                                                        apply, byGetter)+import           Follow.Types                (Entry (..), EntryGetter, Fetched,+                                              Middleware, Recipe (..), Step,+                                              Subject (..))+import           Network.HTTP.Req            (MonadHttp)++type FetcherParser m = Object -> Parser (Fetched m)++type MiddlewareParser = Object -> Parser Middleware++data ParsedEntryGetter+  = PEG (EntryGetter Text)+  | PET (EntryGetter LocalTime)++-- | @+--   title: Title+--   description: Description+--   tags: [tag_1, tag_2]+--   @+instance FromJSON Subject where+  parseJSON =+    withObject "Subject" $ \v -> do+      title <- v .: "title"+      description <- v .: "description"+      tags <- v .: "tags"+      return $+        Subject {sTitle = title, sDescription = description, sTags = tags}++-- | @+--   type: text+--   options:+--     css: .selector+--   @+--+--   or+--+--   @+--   type: attr+--   options:+--     css: .link+--     name: href+--   @+instance FromJSON F.WebScraping.SelectorItem where+  parseJSON =+    withObject "SelectorItem" $ \v -> do+      kind <- v .: "type"+      options <- v .: "options"+      case (kind :: Text) of+        "attr" -> do+          css <- options .: "css"+          attr <- options .: "name"+          return $ F.WebScraping.Attr css attr+        "text" -> do+          css <- options .: "css"+          return $ F.WebScraping.InnerText css+        x -> fail $ concat ["Unknown type '", T.unpack x, "' for selector item"]++-- | @+--   uri: # See `SelectorItem` instance+--   title: null+--   description: null+--   guid: null+--   author: null+--   publish_date: null+--  @+instance FromJSON F.WebScraping.Selector where+  parseJSON =+    withObject "Selector" $ \v -> do+      uri <- v .: "uri"+      guid <- v .: "guid"+      title <- v .: "title"+      description <- v .: "description"+      author <- v .: "author"+      publishDate <- v .: "publish_date"+      return $+        F.WebScraping.Selector+          { F.WebScraping.selURI = uri+          , F.WebScraping.selGUID = guid+          , F.WebScraping.selTitle = title+          , F.WebScraping.selDescription = description+          , F.WebScraping.selAuthor = author+          , F.WebScraping.selPublishDate = publishDate+          }++-- | @utf8@, @utf16le@, @utf16be@, @utf32le@ or @utf32be@+instance FromJSON M.Decode.Encoding where+  parseJSON (String "utf8") = return M.Decode.UTF8+  parseJSON (String "utf16le") = return M.Decode.UTF16LE+  parseJSON (String "utf16be") = return M.Decode.UTF16BE+  parseJSON (String "utf32le") = return M.Decode.UTF32LE+  parseJSON (String "utf32be") = return M.Decode.UTF32BE+  parseJSON (String x) =+    fail $ concat ["Unknown type '", T.unpack x, "' for encoding item"]++instance FromJSON ParsedEntryGetter where+  parseJSON (String "title") = return $ PEG eTitle+  parseJSON (String "description") = return $ PEG eDescription+  parseJSON (String "uri") = return $ PEG eURI+  parseJSON (String "guid") = return $ PEG eGUID+  parseJSON (String "author") = return $ PEG eAuthor+  parseJSON (String "publish_date") = return $ PET ePublishDate+  parseJSON (String x) =+    fail $+    concat ["Unknown field '", T.unpack x, "' for by field comparison function"]++-- | @+--   type: by_field+--   options:+--     field: title+--   @+instance FromJSON M.Sort.ComparisonFunction where+  parseJSON =+    withObject "ComparisonFunction" $ \v -> do+      kind <- v .: "type"+      options <- v .: "options"+      case (kind :: Text) of+        "by_field" -> do+          field <- options .: "field"+          case field of+            PEG g -> return $ M.Sort.byGetter g+            PET g -> return $ M.Sort.byGetter g+        x ->+          fail $+          concat ["Unknown function '", T.unpack x, "' for comparison function"]++-- | @+--   type: equal+--   options:+--     field: title+--     value: Title+--   @+--+--   or+--+--   @+--   type: less+--   options:+--     field: publish_date+--     value: 2018-08-08 00:00:00+--   @+--+--   or+--+--   @+--   type: greater+--   options:+--     field: publish_date+--     value: 2018-08-08 00:00:00+--   @+--+--   or+--+--   @+--   type: infix+--   options:+--     field: title+--     value: something+--   @+--+--   or+--+--   @+--   type: prefix+--   options:+--     field: title+--     value: The+--   @+--+--   or+--+--   @+--   type: suffix+--   options:+--     field: title+--     value: end+--   @+--+--   or+--+--   @+--   type: not+--   options:+--     operator: # See `Predicate` instance+--   @+--+--   or+--+--   @+--   type: and+--   options:+--     operator1: # See `Predicate` instance+--     operator2: # See `Predicate` instance+--   @+--+--   or+--+--   @+--   type: or+--   options:+--     operator1: # See `Predicate` instance+--     operator2: # See `Predicate` instance+--   @+instance FromJSON M.Filter.Predicate where+  parseJSON =+    withObject "Predicate" $ \v -> do+      kind <- v .: "type"+      options <- v .: "options"+      case (kind :: Text) of+        "equal" -> do+          getter <- options .: "field"+          value <- options .: "value"+          case getter of+            PEG g -> returnTextFilter g value M.Filter.equalP+            PET g -> returnTimeFilter g value M.Filter.equalP+        "less" -> do+          getter <- options .: "field"+          value <- options .: "value"+          case getter of+            PEG g -> returnTextFilter g value M.Filter.lessP+            PET g -> returnTimeFilter g value M.Filter.lessP+        "greater" -> do+          getter <- options .: "field"+          value <- options .: "value"+          case getter of+            PEG g -> returnTextFilter g value M.Filter.greaterP+            PET g -> returnTimeFilter g value M.Filter.greaterP+        "infix" -> dispatchTextFilter options M.Filter.infixP "infix"+        "prefix" -> dispatchTextFilter options M.Filter.prefixP "prefix"+        "suffix" -> dispatchTextFilter options M.Filter.suffixP "suffix"+        "not" -> do+          operation <- options .: "operation"+          return $ M.Filter.notP operation+        "and" -> do+          operation1 <- options .: "operation1"+          operation2 <- options .: "operation2"+          return $ M.Filter.andP operation1 operation2+        "or" -> do+          operation1 <- options .: "operation1"+          operation2 <- options .: "operation2"+          return $ M.Filter.orP operation1 operation2+    where+      returnTextFilter getter value builder = return $ builder getter value+      returnTimeFilter getter value builder =+        let time = parseTimeGuess value :: Maybe LocalTime+         in case time of+              Nothing -> fail "Format for time is unknown"+              Just t  -> return $ builder getter t+      dispatchTextFilter object builder name = do+        getter <- object .: "field"+        value <- object .: "value"+        case getter of+          PEG g -> return $ builder value g+          PET g ->+            fail $+            concat+              [ "Tried to apply '"+              , name+              , "' filter with a field which is not text"+              ]++-- | @+--   type: feed+--   options:+--     url: http://someurl.com+--   @+--+--   or+--+--   @+--   type: webscraping+--   options:+--     url: http://someurl.com+--     selector: # See `Selector` instance+--   @+instance (MonadThrow m, MonadHttp m) => FromJSON (Fetched m) where+  parseJSON =+    withObject "Fetcher" $ \v -> do+      kind <- v .: "type"+      options <- v .: "options"+      dispatchToFetcher kind options++-- | @+--   type: decode+--   options:+--     encoding: # See `Encoding` instance+--  @+--+--  or+--+--  @+--   type: sort+--   options:+--     function: # See `ComparisonInstance` instance+--  @+--+--  or+--+--  @+--   type: filter+--   options:+--     operation: # See `Predicate` instance+--  @+instance FromJSON Middleware where+  parseJSON =+    withObject "Middleware" $ \v -> do+      kind <- v .: "type"+      options <- v .: "options"+      dispatchToMiddleware kind options++-- | @+--   subject: # See `Subject` instance+--   steps:+--     -+--       - # See `Fetched` instance+--       -+--         - # See `Middleware` instance+--   middlewares:"+--     - # See `Middleware` instance+--  @+instance (MonadThrow m, MonadHttp m) => FromJSON (Recipe m) where+  parseJSON =+    withObject "Recipe" $ \v -> do+      subject <- v .: "subject"+      steps <- v .: "steps"+      middlewares <- v .: "middlewares"+      return+        Recipe {rSubject = subject, rSteps = steps, rMiddlewares = middlewares}++dispatchToFetcher ::+     (MonadThrow m, MonadHttp m) => Text -> Value -> Parser (Fetched m)+dispatchToFetcher kind options =+  case kind of+    "feed"        -> withObject "Options" parseFFeed options+    "webscraping" -> withObject "Options" parseFWebScraping options++parseFFeed :: (MonadThrow m, MonadHttp m) => FetcherParser m+parseFFeed o = do+  url <- o .: "url"+  return $ F.Feed.fetch (T.encodeUtf8 url)++parseFWebScraping :: (MonadThrow m, MonadHttp m) => FetcherParser m+parseFWebScraping o = do+  url <- o .: "url"+  selector <- o .: "selector"+  return $ F.WebScraping.fetch (T.encodeUtf8 url) selector++dispatchToMiddleware :: Text -> Value -> Parser Middleware+dispatchToMiddleware kind options =+  case kind of+    "decode" -> withObject "Options" parseMDecode options+    "sort"   -> withObject "Options" parseMSort options+    "filter" -> withObject "Options" parseMFilter options++parseMDecode :: MiddlewareParser+parseMDecode o = do+  encoding <- o .: "encoding"+  return $ M.Decode.apply encoding++parseMSort :: MiddlewareParser+parseMSort o = do+  function <- o .: "function"+  return $ M.Sort.apply function++parseMFilter :: MiddlewareParser+parseMFilter o = do+  predicate <- o .: "operation"+  return $ M.Filter.apply predicate

@@ -0,0 +1,70 @@+{-|+Description: Definition of types.++This module defines the types used in the whole application.+-}+module Follow.Types+  ( Recipe(..)+  , Subject(..)+  , Entry(..)+  , Fetched+  , EntryGetter+  , Directory(..)+  , Step+  , Middleware+  , Digester+  ) where++import           Data.Text (Text)+import           Data.Time (LocalTime)+import           Data.Yaml (Object, Parser)++-- | Subject being followed. The whole idea of `Follow` is being able+-- to build strategies to gather URIs for the content published about any+-- subject.+data Subject = Subject+  { sTitle       :: Text -- ^ Title.+  , sDescription :: Text -- ^ Description.+  , sTags        :: [Text] -- ^ List of tags.+  } deriving (Eq, Show)++-- | An item of content that has been published somewhere.+data Entry = Entry+  { eURI         :: Maybe Text -- ^ URI that identifies the location of the item.+  , eGUID        :: Maybe Text -- ^ Unique identifier.+  , eTitle       :: Maybe Text -- ^ Title.+  , eDescription :: Maybe Text -- ^ Description.+  , eAuthor      :: Maybe Text -- ^ Author.+  , ePublishDate :: Maybe LocalTime -- ^ Item publish date.+  } deriving (Eq, Show)++-- | Entries fetched usually from the outside world.+type Fetched m = m [Entry]++-- | Function that returns a field from an `Entry`. They are the -+-- automatically generated methods for the `Entry` record.+type EntryGetter a = Entry -> Maybe a++-- | Gathering of `Item` published for some `Subject`.+data Directory = Directory+  { dSubject :: Subject -- ^ The subject.+  , dEntries :: [Entry] -- ^ The list of entries.+  } deriving (Eq, Show)++-- | Middleware does something to a directory.+type Middleware = Directory -> Directory++-- | A list of middlewares to be applied to some fetched entries.+type Step m = (Fetched m, [Middleware])++-- | A recipe is a specification of a complete strategy to create the+-- content to follow a subject.+data Recipe m = Recipe+  { rSubject     :: Subject -- ^ The subject being followed.+  , rSteps       :: [Step m] -- ^ List of steps to be applied.+  , rMiddlewares :: [Middleware] -- ^ List of middlewares to apply to the result of all steps.+  }++-- | Digesters are strategies to transform a directory into something+-- to be consumed by an end user.+type Digester a = Directory -> a

@@ -0,0 +1,47 @@+{-# LANGUAGE DataKinds      #-}+{-# LANGUAGE DeriveAnyClass #-}++{-|+Description: HTTP utils used elsewhere in the library.++This module contains HTTP functions needed and used from other modules+within the `Follow` library.+-}+module HTTP.Follow+  ( parseUrl+  , getResponseBody+  , HTTPError(..)+  ) where++import           Control.Monad.Catch  (Exception, MonadThrow, throwM)+import qualified Data.ByteString      as BS (ByteString)+import qualified Data.ByteString.Lazy as BL (ByteString)+import qualified Network.HTTP.Req     as R (GET (..), HttpException, MonadHttp,+                                            NoReqBody (..), Option, Scheme (..),+                                            Url, handleHttpException,+                                            lbsResponse, parseUrl, req,+                                            responseBody)++type Url s = (R.Url s, R.Option s)++type EitherUrl = (Either (Url R.Http) (Url R.Https))++-- HTTP errors+data HTTPError =+  URLWrongFormat+  deriving (Eq, Show, Exception)++-- | Parses a url type from a textual representation.+parseUrl :: (MonadThrow m) => BS.ByteString -> m EitherUrl+parseUrl url = maybe (throwM URLWrongFormat) return (R.parseUrl url)++-- | Performs a request to given url and returns just the response body+getResponseBody :: (R.MonadHttp m, MonadThrow m) => EitherUrl -> m BL.ByteString+getResponseBody = either fetch fetch+  where+    fetch (url, option) =+      R.responseBody <$> R.req R.GET url R.NoReqBody R.lbsResponse option++-- | Declares how to handle request errors for IO monad.+instance R.MonadHttp IO where+  handleHttpException = throwM

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Time.FollowSpec where++import           Data.Time        (UTCTime)+import           Data.Time.Follow+import           Test.Hspec++spec :: Spec+spec =+  describe ".parseTimeGuess" $ do+    it "parses from iso8601" $ do+      let string = "2018-09-02"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 00:00:00 UTC"+    it "parses from iso8601 with time" $ do+      let string = "2018-09-02T01:00:00"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 01:00:00 UTC"+    it "parses from iso8601 with time and timezone" $ do+      let string = "2018-09-02T01:00:00+0000"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 01:00:00 UTC"+    it "parses from iso8601 with fractions of seconds" $ do+      let string = "2018-09-02T01:00:00.001000"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 01:00:00.001 UTC"+    it "parses from iso8601 with fractions of seconds and timezone" $ do+      let string = "2018-09-02T01:00:00.001000+0000"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 01:00:00.001 UTC"+    it "parses from rfc822" $ do+      let string = "Sun, 02 Sep 2018 01:00:00 +0000"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 01:00:00 UTC"+    it "parses from epoch" $ do+      let string = "1535846400"+      let time = parseTimeGuess string :: Maybe UTCTime+      (show <$> time) `shouldBe` Just "2018-09-02 00:00:00 UTC"+    it "returns Nothing when unknown" $ do+      let string = "None"+      let time = parseTimeGuess string :: Maybe UTCTime+      time `shouldBe` Nothing

@@ -0,0 +1,28 @@+<?xml version="1.0" encoding="UTF-8" ?>+<rss version="2.0">+<channel>+ <title>RSS Title</title>+ <description>This is an example of an RSS feed</description>+ <link>http://www.example.com/main.html</link>+ <lastBuildDate>Mon, 06 Sep 2010 00:01:00 +0000 </lastBuildDate>+ <pubDate>Sun, 06 Sep 2009 16:20:00 +0000</pubDate>+ <ttl>1800</ttl>++ <item>+  <title>Example entry</title>+  <description>Short description.</description>+  <link>http://www.example.com/blog/post/1</link>+  <guid isPermaLink="false">7bd204c6-1655-4c27-aeee-53f933c5395f</guid>+  <pubDate>Sun, 06 Sep 2009 16:20:00 +0000</pubDate>+  <author>Joe Doe</author>+ </item>++ <item>+  <title>Second example entry</title>+  <description>Here is some text containing an interesting description for the second example.</description>+  <link>http://www.example.com/blog/post/2</link>+  <guid isPermaLink="false">8bd204c6-1655-4c27-aeee-53f933c5395f</guid>+  <pubDate>Sun, 06 Sep 2009 16:20:00 +0000</pubDate>+ </item>+</channel>+</rss>

@@ -0,0 +1,27 @@+<!DOCTYPE html>+<html lang="en"> +  <head>+    <title>Sample Blog</title>+  </head>+  <body>+    <h1>Sample Blog</h1>+    <article>+      <p class="title"><a href="http://sampleblog.com/first-article">First article</a></p>+      <p class="description">Description of the first article</p>+      <p class="author">Joe Doe</p>+      <p class="publish-date" datetime="1535684406">Yesterday</p>+    </article>+    <article>+      <p class="title"><a href="http://sampleblog.com/second-article">Second article</a></p>+      <p class="description">Description of the second article</p>+      <p class="author">Joe Doe</p>+    </article>+    <article>+      <p class="title">Here article link is missing</p>+      <p class="description">Description of the missing article</p>+      <p class="author">Joe Doe</p>+    </article>+  </body>+  </body>+  </body>+</html>

@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Digesters.SimpleTextSpec where++import qualified Data.Text                   as T (isInfixOf)+import           Data.Time                   (LocalTime)+import           Follow.Digesters.SimpleText+import           Follow.Types                (Directory (..), Entry (..),+                                              Subject (..))+import           Test.Hspec++spec :: Spec+spec =+  describe ".digest" $ do+    let isInfixOf' = flip T.isInfixOf+    let subject = Subject "Subject Title" "Subject Description" ["tag"]+    let entries =+          [ Entry+              (Just "http://a_url.com")+              (Just "a_guid")+              (Just "Entry Title")+              (Just "Entry Description")+              (Just "Entry Author")+              (Just (read "2009-09-06 16:20:00" :: LocalTime))+          ]+    let directory = Directory subject entries+    let output = digest directory+    it "adds subject title" $ do+      "Subject Title" `shouldSatisfy` (isInfixOf' output)+    it "adds subject description" $ do+      "Subject Description" `shouldSatisfy` (isInfixOf' output)+    it "adds subject tags" $ do "tag" `shouldSatisfy` (isInfixOf' output)+    it "adds each entry URL" $ do+      "http://a_url.com" `shouldSatisfy` (isInfixOf' output)+    it "adds each entry title" $ do+      "Entry Title" `shouldSatisfy` (isInfixOf' output)+    it "adds each entry description" $ do+      "Entry Description" `shouldSatisfy` (isInfixOf' output)+    it "adds each entry author" $ do+      "Entry Author" `shouldSatisfy` (isInfixOf' output)+    it "adds each entry publish date" $ do+      "2009-09-06 16:20:00" `shouldSatisfy` (isInfixOf' output)

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Fetchers.Feed.InternalSpec where++import qualified Data.ByteString               as BS (ByteString)+import           Data.Time                     (LocalTime)+import           Follow.Fetchers.Feed.Internal+import           Follow.Types                  (Entry (..))+import           Test.Hspec+import qualified Text.Feed.Import              as F (parseFeedFromFile)+import qualified Text.Feed.Types               as F (Feed)++loadFeedFromFile :: IO F.Feed+loadFeedFromFile = F.parseFeedFromFile "test/Fixtures/rss.xml"++spec :: Spec+spec = do+  describe ".feedToEntries" $ do+    before loadFeedFromFile $ do+      it "adds an entry for each feed item" $ \feed -> do+        let entries = feedToEntries feed+        length entries `shouldBe` 2+      it "sets item link as entry uri" $ \feed -> do+        let entry = head $ feedToEntries feed+        eURI entry `shouldBe` Just "http://www.example.com/blog/post/1"+      it "sets item guid as entry id" $ \feed -> do+        let entry = head $ feedToEntries feed+        eGUID entry `shouldBe` Just "7bd204c6-1655-4c27-aeee-53f933c5395f"+      it "sets item title as entry title" $ \feed -> do+        let entry = head $ feedToEntries feed+        eTitle entry `shouldBe` Just "Example entry"+      it "sets item description as entry description" $ \feed -> do+        let entry = head $ feedToEntries feed+        eDescription entry `shouldBe` Just "Short description."+      it "sets item author as entry author" $ \feed -> do+        let entry = head $ feedToEntries feed+        eAuthor entry `shouldBe` Just "Joe Doe"+      it "sets item publish date as entry publish date" $ \feed -> do+        let entry = head $ feedToEntries feed+        ePublishDate entry `shouldBe`+          Just (read "2009-09-06 16:20:00" :: LocalTime)

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Fetchers.FeedSpec where++import           Data.Maybe               (fromJust)+import qualified Data.Text                as T (isInfixOf, pack)+import           Follow.Fetchers.Feed+import           Follow.Types             (Entry (..))+import           Helpers.EndPointFixtures (endPointWithStatus, feedEndPoint,+                                           invalidEndPoint, simpleEndPoint)+import           HTTP.Follow              (HTTPError (..))+import qualified Network.HTTP.Req         as R (HttpException (..))+import           Test.Hspec++spec :: Spec+spec = do+  describe ".fetcher" $ do+    it "fetches entries from given url" $ do+      entries <- fetch feedEndPoint+      let entry = head entries+      let url = (fromJust . eURI) entry+      T.isInfixOf "nytimes" url `shouldBe` True+    it "returns error when URL is not valid" $ do+      fetch invalidEndPoint `shouldThrow` (== URLWrongFormat)+    it "returns error when response can't be parsed to a feed" $ do+      fetch simpleEndPoint `shouldThrow` (== FeedWrongFormat)+    it "returns the http error when it happens" $ do+      fetch (endPointWithStatus 404) `shouldThrow` \e ->+        "HttpException" `T.isInfixOf` (T.pack $ show (e :: R.HttpException))

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Fetchers.WebScraping.InternalSpec where++import           Data.ByteString.Lazy                 as BL (ByteString)+import           Data.ByteString.Lazy.Char8           as BL (pack)+import           Follow.Fetchers.WebScraping.Internal+import           Follow.Types                         (Entry (..))+import           Test.Hspec++loadHtmlFromFile :: IO BL.ByteString+loadHtmlFromFile = BL.pack <$> readFile "test/Fixtures/webscraping.html"++spec :: Spec+spec =+  describe ".htmlToEntries" $ do+    let selector =+          Selector+            { selURI = Just $ Attr "article a" "href"+            , selGUID = Just $ Attr "article a" "href"+            , selTitle = Just $ InnerText ".title a"+            , selDescription = Just $ InnerText ".description"+            , selAuthor = Just $ InnerText ".author"+            , selPublishDate = Just $ Attr ".publish-date" "datetime"+            }+    before loadHtmlFromFile $ do+      it "creates as many entries as links" $ \html -> do+        entries <- htmlToEntries html selector+        length entries `shouldBe` 2+      it "uses URI selector to parse URIs" $ \html -> do+        entry <- head <$> htmlToEntries html selector+        eURI entry `shouldBe` Just "http://sampleblog.com/first-article"+      it "uses GUID selector to parse GUIDs" $ \html -> do+        entry <- head <$> htmlToEntries html selector+        eGUID entry `shouldBe` Just "http://sampleblog.com/first-article"+      it "uses title selector to parse titles" $ \html -> do+        entry <- head <$> htmlToEntries html selector+        eTitle entry `shouldBe` Just "First article"+      it "uses description selector to parse descriptions" $ \html -> do+        entry <- head <$> htmlToEntries html selector+        eDescription entry `shouldBe` Just "Description of the first article"+      it "uses publish date selector to parse publish dates" $ \html -> do+        pendingWith+          "https://mail.haskell.org/pipermail/haskell-cafe/2018-September/129934.html"+        entry <- head <$> htmlToEntries html selector+        (show <$> ePublishDate entry) `shouldBe` Just "2018-08-31 03:00:06"+      it "fills unmatched with Nothing" $ \html -> do+        entry <- head . tail <$> htmlToEntries html selector+        ePublishDate entry `shouldBe` Nothing

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Fetchers.WebScrapingSpec where++import           Data.Maybe                  (fromJust)+import qualified Data.Text                   as T (isInfixOf, pack)+import           Follow.Fetchers.WebScraping+import           Follow.Types                (Entry (..))+import           Helpers.EndPointFixtures+import           Helpers.Factories+import           HTTP.Follow                 (HTTPError (..))+import qualified Network.HTTP.Req            as R (HttpException (..))+import           Test.Hspec++spec :: Spec+spec =+  describe ".fetch" $ do+    let selector = _selector {selURI = Just (Attr ".headline a" "href")}+    it "fetches entries from given url" $ do+      entries <- fetch webScrapingEndPoint selector+      let entry = head entries+      let url = (fromJust . eURI) entry+      T.isInfixOf "nytimes" url `shouldBe` True+    it "returns error when URL is not valid" $ do+      fetch invalidEndPoint selector `shouldThrow` (== URLWrongFormat)+    it "returns the http error when it happens" $ do+      fetch (endPointWithStatus 404) selector `shouldThrow` \e ->+        "HttpException" `T.isInfixOf` (T.pack $ show (e :: R.HttpException))

@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Middlewares.Filter.InternalSpec where++import           Follow.Middlewares.Filter.Internal+import           Follow.Types                       (Entry (..))+import           Helpers.Factories+import           Test.Hspec++spec :: Spec+spec = do+  describe ".equalP" $ do+    it "returns true on equality" $ do+      let entry = _entry {eURI = Just "http://url.com"}+      (eURI `equalP` "http://url.com") entry `shouldBe` True+    it "returns false on inequality" $ do+      let entry = _entry {eGUID = Just "GUID1"}+      (eGUID `equalP` "GUID2") entry `shouldBe` False+    it "returns false when field is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      (eTitle `equalP` "Title") entry `shouldBe` False+  describe ".infixP" $ do+    it "returns true when needle is contained" $ do+      let entry = _entry {eURI = Just "http://this_is_a_url.com"}+      ("url" `infixP` eURI) entry `shouldBe` True+    it "returns false when needle is not contained" $ do+      let entry = _entry {eGUID = Just "GUID1"}+      ("NO" `infixP` eGUID) entry `shouldBe` False+    it "returns false when field is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      ("Title" `infixP` eTitle) entry `shouldBe` False+  describe ".prefixP" $ do+    it "returns true when needle is prefix" $ do+      let entry = _entry {eURI = Just "http://url.com"}+      ("http://" `prefixP` eURI) entry `shouldBe` True+    it "returns false when needle is not prefix" $ do+      let entry = _entry {eGUID = Just "GUID1"}+      ("NO" `prefixP` eGUID) entry `shouldBe` False+    it "returns false when field is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      ("Title" `prefixP` eTitle) entry `shouldBe` False+  describe ".suffixP" $ do+    it "returns true when needle is suffix" $ do+      let entry = _entry {eURI = Just "http://url.com"}+      (".com" `suffixP` eURI) entry `shouldBe` True+    it "returns false when needle is not suffix" $ do+      let entry = _entry {eGUID = Just "GUID1"}+      ("NO" `suffixP` eGUID) entry `shouldBe` False+    it "returns false when field is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      ("Title" `suffixP` eTitle) entry `shouldBe` False+  describe ".lessP" $ do+    it "returns true when item is lesser" $ do+      let entry = _entry {eTitle = Just "A"}+      (eTitle `lessP` "B") entry `shouldBe` True+    it "returns false when item is not lesser" $ do+      let entry = _entry {eTitle = Just "C"}+      (eTitle `lessP` "B") entry `shouldBe` False+    it "returns false when item is equal" $ do+      let entry = _entry {eTitle = Just "A"}+      (eTitle `lessP` "A") entry `shouldBe` False+    it "returns false when item is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      (eTitle `lessP` "A") entry `shouldBe` False+  describe ".greaterP" $ do+    it "returns true when item is greater" $ do+      let entry = _entry {eTitle = Just "C"}+      (eTitle `greaterP` "A") entry `shouldBe` True+    it "returns false when item is not greater" $ do+      let entry = _entry {eTitle = Just "A"}+      (eTitle `greaterP` "B") entry `shouldBe` False+    it "returns false when item is equal" $ do+      let entry = _entry {eTitle = Just "A"}+      (eTitle `greaterP` "A") entry `shouldBe` False+    it "returns false when item is Nothing" $ do+      let entry = _entry {eTitle = Nothing}+      (eTitle `greaterP` "A") entry `shouldBe` False+  describe ".andP" $ do+    let entry = _entry {eTitle = Just "The Title"}+    it "returns true when both predicates apply" $ do+      (("The" `prefixP` eTitle) `andP` ("Title" `suffixP` eTitle)) entry `shouldBe`+        True+    it "returns false when first predicates fails" $ do+      (("NO" `prefixP` eTitle) `andP` ("Title" `suffixP` eTitle)) entry `shouldBe`+        False+    it "returns false when second predicates fails" $ do+      (("The" `prefixP` eTitle) `andP` ("NO" `suffixP` eTitle)) entry `shouldBe`+        False+    it "returns false when both predicates fail" $ do+      (("NO" `prefixP` eTitle) `andP` ("NEITHER" `suffixP` eTitle)) entry `shouldBe`+        False+  describe ".orP" $ do+    let entry = _entry {eTitle = Just "The Title"}+    it "returns true when both predicates apply" $ do+      (("The" `prefixP` eTitle) `orP` ("Title" `suffixP` eTitle)) entry `shouldBe`+        True+    it "returns true when first predicates applies" $ do+      (("The" `prefixP` eTitle) `orP` ("NO" `suffixP` eTitle)) entry `shouldBe`+        True+    it "returns true when second predicates applies" $ do+      (("NO" `prefixP` eTitle) `orP` ("Title" `suffixP` eTitle)) entry `shouldBe`+        True+    it "returns false when both predicates fail" $ do+      (("NO" `prefixP` eTitle) `orP` ("NEITHER" `suffixP` eTitle)) entry `shouldBe`+        False+  describe ".notP" $ do+    let entry = _entry {eTitle = Just "The Title"}+    it "returns true when predicate does not apply" $ do+      notP ("NO" `prefixP` eTitle) entry `shouldBe` True+    it "returns false when predicate applies" $ do+      notP ("The" `prefixP` eTitle) entry `shouldBe` False

@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Middlewares.FilterSpec where++import           Follow.Middlewares.Filter+import           Follow.Types              (Directory (..), Entry (..))+import           Helpers.Factories+import           Test.Hspec++spec :: Spec+spec =+  describe ".apply" $ do+    it "filter entries according to given predicate" $ do+      let entry1 = _entry {eTitle = Just "A"}+      let entry2 = _entry {eTitle = Just "B"}+      let directory = Directory _subject [entry1, entry2]+      let directory' = apply (eTitle `equalP` "A") directory+      dEntries directory' `shouldBe` [entry1]

@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.Middlewares.SortSpec where++import           Follow.Middlewares.Sort+import           Follow.Types            (Directory (..), Entry (..))+import           Helpers.Factories+import           Test.Hspec++spec :: Spec+spec = do+  describe ".apply" $ do+    it "sorts by given field getter" $ do+      let entry1 = _entry {eTitle = Just "DEF"}+      let entry2 = _entry {eTitle = Just "ABC"}+      let directory = Directory _subject [entry1, entry2]+      let sortedDirectory = apply (byGetter eTitle) directory+      dEntries sortedDirectory `shouldBe` [entry2, entry1]

@@ -0,0 +1,352 @@+{-# LANGUAGE OverloadedStrings #-}++module Follow.ParserSpec where++import           Control.Monad.Catch         (MonadThrow)+import           Data.ByteString             (ByteString)+import qualified Data.ByteString.Char8       as B (unlines)+import           Data.List                   (isInfixOf)+import           Data.Time                   (LocalTime)+import           Data.Yaml                   (FromJSON, ParseException,+                                              decodeThrow)+import           Follow                      (directoryFromRecipe)+import qualified Follow.Fetchers.WebScraping as F.WebScraping (Selector (..),+                                                               SelectorItem (..))+import qualified Follow.Middlewares.Decode   as M.Decode (Encoding (..))+import qualified Follow.Middlewares.Filter   as M.Filter (Predicate)+import qualified Follow.Middlewares.Sort     as M.Sort (ComparisonFunction)+import           Follow.Parser+import           Follow.Types                (Directory (..), Entry (..),+                                              Fetched, Recipe (..),+                                              Subject (..))+import           Helpers.Factories+import           HTTP.Follow                 (HTTPError (..))+import           Test.Hspec++decode' :: (MonadThrow m, FromJSON a) => ByteString -> m a+decode' = decodeThrow++spec :: Spec+spec = do+  describe ".FromJSON" $ do+    describe "Subject" $ do+      it "has instance" $ do+        let string =+              B.unlines+                ["title: Title", "description: Description", "tags: [tag]"]+        subject <- decode' string :: IO Subject+        subject `shouldBe`+          Subject+            {sTitle = "Title", sDescription = "Description", sTags = ["tag"]}+    describe "SelectorItem" $ do+      it "recognizes Attr constructor" $ do+        let string =+              B.unlines+                ["type: attr", "options:", "  css: .selector", "  name: href"]+        item <- decode' string :: IO F.WebScraping.SelectorItem+        item `shouldBe` F.WebScraping.Attr ".selector" "href"+      it "recognizes InnerText constructor" $ do+        let string = B.unlines ["type: text", "options:", "  css: .selector"]+        item <- decode' string :: IO F.WebScraping.SelectorItem+        item `shouldBe` F.WebScraping.InnerText ".selector"+      it "throws custom error when type is unknown" $ do+        let string = B.unlines ["type: unknown", "options:", "  css: .selector"]+        (decode' string :: IO F.WebScraping.SelectorItem) `shouldThrow` \e ->+          ("Unknown type 'unknown' for selector item" `isInfixOf`+           show (e :: ParseException))+    describe "Selector" $ do+      it "has instance" $ do+        let string =+              B.unlines+                [ "uri:"+                , "  type: text"+                , "  options:"+                , "    css: .uri"+                , "guid:"+                , "  type: attr"+                , "  options:"+                , "    css: .guid"+                , "    name: href"+                , "title: null"+                , "description: null"+                , "author: null"+                , "publish_date: null"+                ]+        selector <- decode' string :: IO F.WebScraping.Selector+        selector `shouldBe`+          F.WebScraping.Selector+            { F.WebScraping.selURI = Just $ F.WebScraping.InnerText ".uri"+            , F.WebScraping.selGUID = Just $ F.WebScraping.Attr ".guid" "href"+            , F.WebScraping.selTitle = Nothing+            , F.WebScraping.selDescription = Nothing+            , F.WebScraping.selAuthor = Nothing+            , F.WebScraping.selPublishDate = Nothing+            }+    describe "Encoding" $ do+      it "recognizes UTF8 constructor" $ do+        let string = "utf8"+        encoding <- decode' string :: IO M.Decode.Encoding+        encoding `shouldBe` M.Decode.UTF8+      it "recognizes UTF16LE constructor" $ do+        let string = "utf16le"+        encoding <- decode' string :: IO M.Decode.Encoding+        encoding `shouldBe` M.Decode.UTF16LE+      it "recognizes UTF16BE constructor" $ do+        let string = "utf16be"+        encoding <- decode' string :: IO M.Decode.Encoding+        encoding `shouldBe` M.Decode.UTF16BE+      it "recognizes UTF32LE constructor" $ do+        let string = "utf32le"+        encoding <- decode' string :: IO M.Decode.Encoding+        encoding `shouldBe` M.Decode.UTF32LE+      it "recognizes UTF32BE constructor" $ do+        let string = "utf32be"+        encoding <- decode' string :: IO M.Decode.Encoding+        encoding `shouldBe` M.Decode.UTF32BE+      it "throws custom error when type is unknown" $ do+        let string = "unknown"+        (decode' string :: IO M.Decode.Encoding) `shouldThrow` \e ->+          ("Unknown type 'unknown' for encoding" `isInfixOf`+           show (e :: ParseException))+    describe "ComparisonFunction" $ do+      it "recognizes byGetter with each field" $ do+        let string = B.unlines ["type: by_field", "options:", "  field: title"]+        function <- decode' string :: IO M.Sort.ComparisonFunction+        let entry1 = _entry {eTitle = Just "A"}+        let entry2 = _entry {eTitle = Just "B"}+        function entry1 entry2 `shouldBe` LT+      it "throws custom error when field is unknown" $ do+        let string =+              B.unlines ["type: by_field", "options:", "  field: unknown"]+        (decode' string :: IO M.Sort.ComparisonFunction) `shouldThrow` \e ->+          ("Unknown field 'unknown' for by field comparison function" `isInfixOf`+           show (e :: ParseException))+      it "throws custom error when type is unknown" $ do+        let string = B.unlines ["type: unknown", "options:", "  field: unknown"]+        (decode' string :: IO M.Sort.ComparisonFunction) `shouldThrow` \e ->+          ("Unknown function 'unknown' for comparison function" `isInfixOf`+           show (e :: ParseException))+    describe "Predicate" $ do+      it "recognizes equalP" $ do+        let string =+              B.unlines+                ["type: equal", "options:", "  field: title", "  value: A"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "A"}+        predicate entry `shouldBe` True+      it "recognizes lessP" $ do+        let string =+              B.unlines+                ["type: less", "options:", "  field: title", "  value: B"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "A"}+        predicate entry `shouldBe` True+      it "recognizes greaterP" $ do+        let string =+              B.unlines+                ["type: greater", "options:", "  field: title", "  value: A"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "B"}+        predicate entry `shouldBe` True+      it "recognizes infixP" $ do+        let string =+              B.unlines+                ["type: infix", "options:", "  field: title", "  value: B"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABC"}+        predicate entry `shouldBe` True+      it "fails with custom error when infixP is given with non text getter" $ do+        let string =+              B.unlines+                [ "type: infix"+                , "options:"+                , "  field: publish_date"+                , "  value: A"+                ]+        (decode' string :: IO M.Filter.Predicate) `shouldThrow` \e ->+          ("Tried to apply 'infix' filter with a field which is not text" `isInfixOf`+           show (e :: ParseException))+      it "recognizes prefixP" $ do+        let string =+              B.unlines+                ["type: prefix", "options:", "  field: title", "  value: A"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABC"}+        predicate entry `shouldBe` True+      it "fails with custom error when prefixP is given with non text getter" $ do+        let string =+              B.unlines+                [ "type: prefix"+                , "options:"+                , "  field: publish_date"+                , "  value: A"+                ]+        (decode' string :: IO M.Filter.Predicate) `shouldThrow` \e ->+          ("Tried to apply 'prefix' filter with a field which is not text" `isInfixOf`+           show (e :: ParseException))+      it "recognizes suffixP" $ do+        let string =+              B.unlines+                ["type: suffix", "options:", "  field: title", "  value: C"]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABC"}+        predicate entry `shouldBe` True+      it "fails with custom error when prefixP is given with non text getter" $ do+        let string =+              B.unlines+                [ "type: suffix"+                , "options:"+                , "  field: publish_date"+                , "  value: A"+                ]+        (decode' string :: IO M.Filter.Predicate) `shouldThrow` \e ->+          ("Tried to apply 'suffix' filter with a field which is not text" `isInfixOf`+           show (e :: ParseException))+      it "recognizes notP" $ do+        let string =+              B.unlines+                [ "type: not"+                , "options:"+                , "  operation:"+                , "    type: prefix"+                , "    options:"+                , "      field: title"+                , "      value: D"+                ]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABC"}+        predicate entry `shouldBe` True+      it "recognizes andP" $ do+        let string =+              B.unlines+                [ "type: and"+                , "options:"+                , "  operation1:"+                , "    type: prefix"+                , "    options:"+                , "      field: title"+                , "      value: A"+                , "  operation2:"+                , "    type: suffix"+                , "    options:"+                , "      field: title"+                , "      value: C"+                ]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABC"}+        predicate entry `shouldBe` True+      it "recognizes orP" $ do+        let string =+              B.unlines+                [ "type: or"+                , "options:"+                , "  operation1:"+                , "    type: prefix"+                , "    options:"+                , "      field: title"+                , "      value: A"+                , "  operation2:"+                , "    type: suffix"+                , "    options:"+                , "      field: title"+                , "      value: C"+                ]+        predicate <- decode' string :: IO M.Filter.Predicate+        let entry = _entry {eTitle = Just "ABD"}+        predicate entry `shouldBe` True+      it "fails with custom error when format for a time field is unknown" $ do+        let string =+              B.unlines+                [ "type: equal"+                , "options:"+                , "  field: publish_date"+                , "  value: unknown"+                ]+        (decode' string :: IO M.Filter.Predicate) `shouldThrow` \e ->+          ("Format for time is unknown" `isInfixOf` show (e :: ParseException))+  describe "Fetcher" $ do+    it "recognizes feed" $ do+      let string = B.unlines ["type: feed", "options:", "  url: invalid"]+      fetched <- decode' string :: IO (Fetched IO)+      fetched `shouldThrow` (== URLWrongFormat)+    it "recognizes web scraping" $ do+      let string =+            B.unlines+              [ "type: webscraping"+              , "options:"+              , "  url: invalid"+              , "  selector:"+              , "    title: null"+              , "    description: null"+              , "    uri: null"+              , "    guid: null"+              , "    author: null"+              , "    publish_date: null"+              ]+      fetched <- decode' string :: IO (Fetched IO)+      fetched `shouldThrow` (== URLWrongFormat)+  describe "Middleware" $ do+    it "recognizes decode" $ do+      let string = B.unlines ["type: decode", "options:", "  encoding: utf8"]+      middleware <- decode' string+      let directory = _directory+      middleware directory `shouldBe` directory+    it "recognizes sort" $ do+      let string =+            B.unlines+              [ "type: sort"+              , "options:"+              , "  function:"+              , "    type: by_field"+              , "    options:"+              , "      field: title"+              ]+      middleware <- decode' string+      let entry1 = _entry {eTitle = Just "B"}+      let entry2 = _entry {eTitle = Just "B"}+      let directory = _directory {dEntries = [entry1, entry2]}+      middleware directory `shouldBe` directory {dEntries = [entry2, entry1]}+    it "recognizes filter" $ do+      let string =+            B.unlines+              [ "type: filter"+              , "options:"+              , "  operation:"+              , "    type: equal"+              , "    options:"+              , "      field: title"+              , "      value: A"+              ]+      middleware <- decode' string+      let entry1 = _entry {eTitle = Just "A"}+      let entry2 = _entry {eTitle = Just "B"}+      let directory = _directory {dEntries = [entry1, entry2]}+      middleware directory `shouldBe` directory {dEntries = [entry1]}+  describe "Recipe" $ do+    it "has instance" $ do+      let string =+            B.unlines+              [ "subject:"+              , "  title: Title"+              , "  description: Description"+              , "  tags: [tag]"+              , "steps:"+              , "  -"+              , "    - type: feed"+              , "      options:"+              , "        url: invalid"+              , "    -"+              , "      - type: sort"+              , "        options:"+              , "          function:"+              , "            type: by_field"+              , "            options:"+              , "              field: title"+              , "middlewares:"+              , "  -"+              , "    type: decode"+              , "    options:"+              , "      encoding: utf8"+              ]+      recipe <- decode' string :: IO (Recipe IO)+      directoryFromRecipe recipe `shouldThrow` (== URLWrongFormat)

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++module FollowSpec where++import           Data.Text         (Text)+import qualified Data.Text         as T (concat)+import           Follow+import           Follow.Types      (Digester, Directory (..), Entry (..),+                                    Middleware, Recipe (..), Subject (..))+import           Helpers.Factories+import           Test.Hspec++removeEntriesMiddleware = (\d -> Directory (dSubject d) []) :: Middleware++addEntryMiddleware entry =+  (\directory -> Directory (dSubject directory) $ entry : (dEntries directory)) :: Middleware++spec :: Spec+spec = do+  describe ".directoryFromFetched" $ do+    it "populates Directory Entries out of given fetcher" $ do+      let entry = _entry {eTitle = Just "Fetched"}+      directory <- directoryFromFetched (e2F entry) _subject+      dEntries directory `shouldBe` [entry]+    it "associates given subject with the Directory" $ do+      let subject = _subject {sTitle = "DirectoryFromFetched"}+      directory <- directoryFromFetched (e2F _entry) subject+      dSubject directory `shouldBe` subject+  describe ".applyMiddlewares" $ do+    it "applies in order given middlewares" $ do+      let directory = emptyDirectory _subject+      let middleware1 = addEntryMiddleware $ _entry {eTitle = Just "1"}+      let middleware2 = addEntryMiddleware $ _entry {eTitle = Just "2"}+      let result = applyMiddlewares [middleware1, middleware2] directory+      let resultEntries = dEntries result+      eTitle <$> resultEntries `shouldBe` [Just "2", Just "1"]+  describe ".directoryFromRecipe" $ do+    it "associates given subject to the created directory" $ do+      let recipe = Recipe _subject [] []+      directory <- directoryFromRecipe recipe+      dSubject directory `shouldBe` _subject+    it "concatenates given fetched entries" $ do+      let entry1 = _entry {eTitle = Just "Title 1"}+      let entry2 = _entry {eTitle = Just "Title 2"}+      let recipe = Recipe _subject [((e2F entry1), []), (e2F entry2, [])] []+      directory <- directoryFromRecipe recipe+      dEntries directory `shouldBe` [entry1, entry2]+    it "applies middlewares at each step" $ do+      let entry1 = _entry {eTitle = Just "Title 1"}+      let entry2 = _entry {eTitle = Just "Title 2"}+      let recipe =+            Recipe+              _subject+              [((e2F entry1), [removeEntriesMiddleware]), (e2F entry2, [])]+              []+      directory <- directoryFromRecipe recipe+      dEntries directory `shouldBe` [entry2]+    it "applies middlewares to fetched entries as a whole" $ do+      let entry1 = _entry {eTitle = Just "Title 1"}+      let recipe = Recipe _subject [(e2F entry1, [])] [removeEntriesMiddleware]+      directory <- directoryFromRecipe recipe+      dEntries directory `shouldBe` []+  describe ".applySteps" $ do+    let directory = emptyDirectory _subject+    it "concatenates given fetched entries" $ do+      let entry1 = _entry {eTitle = Just "Title 1"}+      let entry2 = _entry {eTitle = Just "Title 2"}+      directory <- applySteps directory [(e2F entry1, []), (e2F entry2, [])]+      dEntries directory `shouldBe` [entry1, entry2]+    it "applies middlewares at each step" $ do+      let entry1 = _entry {eTitle = Just "Title 1"}+      let entry2 = _entry {eTitle = Just "Title 2"}+      directory <-+        applySteps+          directory+          [(e2F entry1, [removeEntriesMiddleware]), (e2F entry2, [])]+      dEntries directory `shouldBe` [entry2]+  describe ".emptyDirectory" $ do+    let directory = emptyDirectory _subject+    it "assigns given subject" $ do dSubject directory `shouldBe` _subject+    it "assigns empty list as entries" $ do dEntries directory `shouldBe` []+  describe ".mergeEntries" $ do+    let entry1 = _entry {eTitle = Just "1"}+    let entry2 = _entry {eTitle = Just "2"}+    let directory = Directory _subject [entry1]+    it "concatenate entries" $ do+      let directory' = mergeEntries directory [entry2]+      dEntries directory' `shouldBe` [entry1, entry2]+    it "keeps first appearance of duplicates" $ do+      let directory' = mergeEntries directory [entry2, entry1]+      dEntries directory' `shouldBe` [entry1, entry2]

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Helpers.EndPointFixtures+  ( simpleEndPoint+  , endPointWithStatus+  , feedEndPoint+  , webScrapingEndPoint+  , invalidEndPoint+  ) where++import qualified Data.ByteString       as BS (ByteString, concat)+import qualified Data.ByteString.Char8 as BS (pack)++simpleEndPoint :: BS.ByteString+simpleEndPoint = "http://httpbin.org"++endPointWithStatus :: Int -> BS.ByteString+endPointWithStatus status =+  BS.concat ["http://httpbin.org/status/", BS.pack $ show status]++feedEndPoint :: BS.ByteString+feedEndPoint = "http://rss.nytimes.com/services/xml/rss/nyt/HomePage.xml"++webScrapingEndPoint :: BS.ByteString+webScrapingEndPoint = "https://www.nytimes.com/section/world"++invalidEndPoint :: BS.ByteString+invalidEndPoint = "invalidurl"

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Out of the box built record to be used in testing.+module Helpers.Factories+  ( _subject+  , _entry+  , _directory+  , _recipe+  , _selector+  , e2F+  ) where++import           Control.Monad.Catch         (MonadThrow)+import           Follow.Fetchers.WebScraping (Selector (..))+import           Follow.Types                (Directory (..), Entry (..),+                                              Recipe (..), Subject (..))++_entry :: Entry+_entry =+  Entry+    { eURI = Nothing+    , eGUID = Nothing+    , eTitle = Nothing+    , eDescription = Nothing+    , eAuthor = Nothing+    , ePublishDate = Nothing+    }++_subject :: Subject+_subject =+  Subject {sTitle = "Title", sDescription = "Description", sTags = ["tag"]}++_directory :: Directory+_directory = Directory {dSubject = _subject, dEntries = [_entry]}++_recipe :: (MonadThrow m) => Recipe m+_recipe = Recipe {rSubject = _subject, rSteps = [], rMiddlewares = []}++e2F :: (MonadThrow m) => Entry -> m [Entry]+e2F entry = return [entry]++_selector :: Selector+_selector =+  Selector+    { selURI = Nothing+    , selGUID = Nothing+    , selTitle = Nothing+    , selDescription = Nothing+    , selAuthor = Nothing+    , selPublishDate = Nothing+    }

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}