<commit_before>{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contains all the Http fetching and manipulation functions.
-- The module uses the
-- <https://hackage.haskell.org/package/http-conduit-2.1.10.1 Http Conduit> libary.
module Dropp.Http
  ( getItemUpdate
  , getItems
  , writeItemSnapshot)

where


import Dropp.DataTypes
import Dropp.HTML()
import Safe (headMay)
import Text.Printf (printf)
import Control.Exception.Lifted (catch)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Trans (lift)
import qualified Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Lazy.Internal as LBS (ByteString)
import Data.Text.Encoding (encodeUtf8)

import Data.Text
  ( unpack
  , pack
  , append
  , breakOn)

import Data.Aeson
  ( FromJSON
  , encode
  , decode)

import Control.Monad.Trans.Maybe
  ( MaybeT
  , runMaybeT)

import Data.Maybe
  ( fromJust
  , isJust)

import Control.Monad
  ( mzero
  , guard)


import Network.HTTP.Types.Header
  ( ResponseHeaders
  , Header
  , hContentType)

import Network.HTTP.Conduit
  ( Manager
  , Request
  , HttpException
  , RequestBody(RequestBodyLBS)
  , httpLbs
  , method
  , requestBody
  , queryString
  , responseHeaders
  , responseBody
  , parseUrl)

import Text.Parsec
  ( ParseError
  , string
  , parse)


-- | Convenience alias of a Maybe transformer that wraps IO actions and
-- returns a value of some type.
type MaybeIO = MaybeT IO


-- | Update the source availabity and the ebay status for an item data record.
-- The function performs two HTTP calls using an applicative style.
getItemUpdate
    :: Manager -- ^Conduit HTTP manager.
    -> Item -- ^Item record to be updated.
    -> IO Item -- ^IO action returning an updated item record.

getItemUpdate mgr item =
    updateItem item <$>
    getAvailability mgr (sourceUrl item) <*>
    getEbayStatus mgr (ebayUrl item)



-- | Perform an HTTP GET request to fetch a list of items records.
getItems
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe [Item]) -- ^IO action containing a Maybe list of items.

getItems mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the source availability of the item.
getAvailability
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe Availability) -- ^IO computation returning a Maybe availabilty.

getAvailability mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the source availability of the item.
getEbayStatus
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe EbayStatus) -- ^IO computation returning a Maybe Ebay status.

getEbayStatus mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the snaphot of an item.
getSnapshot
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe [Snapshot]) -- ^IO computation returning a Maybe Snapshot list.

getSnapshot mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform the HTTP call with a method of choice.
writeItemSnapshot
    -- :: (ToJSON a) =>
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> Snapshot
    -> IO (Maybe LBS.ByteString)

writeItemSnapshot manager url payload = runMaybeT $ do
    let patchUrl = url `append` pack ("?id=eq." ++ show (snapItemId payload))
    initRequest <- parseUrl $ unpack patchUrl
    let reqBody = RequestBodyLBS $ encode payload
    let request = initRequest {method = "PATCH"} {requestBody = reqBody}
    response <- catch
        (httpLbs request manager)
        (\(_ :: HttpException)-> do
            initPostReq <- parseUrl $ unpack url
            let requestPost = initPostReq {method = "POST"} {requestBody = reqBody}
            catch
                (httpLbs requestPost manager)
                (\ (x :: HttpException)-> do
                    lift $ printf "failed to post %s because of %s\n"
                           (unpack url)
                           (show x)
                    mzero))
<commit_msg>[DPP-78] Linted snapshot functions<commit_after>{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contains all the Http fetching and manipulation functions.
-- The module uses the
-- <https://hackage.haskell.org/package/http-conduit-2.1.10.1 Http Conduit> libary.
module Dropp.Http
  ( getItemUpdate
  , getItems
  , getSnapshot
  , writeItemSnapshot)

where


import Dropp.DataTypes
import Dropp.HTML()
import Safe (headMay)
import Text.Printf (printf)
import Control.Exception.Lifted (catch)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Trans (lift)
import qualified Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Lazy.Internal as LBS (ByteString)
import Data.Text.Encoding (encodeUtf8)

import Data.Text
  ( unpack
  , pack
  , append
  , breakOn)

import Data.Aeson
  ( FromJSON
  , encode
  , decode)

import Control.Monad.Trans.Maybe
  ( MaybeT
  , runMaybeT)

import Data.Maybe
  ( fromJust
  , isJust)

import Control.Monad
  ( mzero
  , guard)


import Network.HTTP.Types.Header
  ( ResponseHeaders
  , Header
  , hContentType)

import Network.HTTP.Conduit
  ( Manager
  , Request
  , HttpException
  , RequestBody(RequestBodyLBS)
  , httpLbs
  , method
  , requestBody
  , queryString
  , responseHeaders
  , responseBody
  , parseUrl)

import Text.Parsec
  ( ParseError
  , string
  , parse)


-- | Convenience alias of a Maybe transformer that wraps IO actions and
-- returns a value of some type.
type MaybeIO = MaybeT IO


-- | Update the source availabity and the ebay status for an item data record.
-- The function performs two HTTP calls using an applicative style.
getItemUpdate
    :: Manager -- ^Conduit HTTP manager.
    -> Item -- ^Item record to be updated.
    -> IO Item -- ^IO action returning an updated item record.

getItemUpdate mgr item =
    updateItem item <$>
    getAvailability mgr (sourceUrl item) <*>
    getEbayStatus mgr (ebayUrl item)



-- | Perform an HTTP GET request to fetch a list of items records.
getItems
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe [Item]) -- ^IO action containing a Maybe list of items.

getItems mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the source availability of the item.
getAvailability
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe Availability) -- ^IO computation returning a Maybe availabilty.

getAvailability mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the source availability of the item.
getEbayStatus
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe EbayStatus) -- ^IO computation returning a Maybe Ebay status.

getEbayStatus mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform an HTTP GET request to fetch the snaphot of an item.
getSnapshot
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> IO (Maybe [Snapshot]) -- ^IO computation returning a Maybe Snapshot list.

getSnapshot mgr url = runMaybeT $ fetchHttp mgr url



-- | Perform the HTTP call with a method of choice.
writeItemSnapshot
    :: Manager -- ^Conduit HTTP manager.
    -> URL -- ^URL to be fetched.
    -> Snapshot
    -> IO (Maybe LBS.ByteString)

writeItemSnapshot manager url payload = runMaybeT $ do
    let patchUrl = url `append` pack ("?id=eq." ++ show (snapItemId payload))
    initRequest <- parseUrl $ unpack patchUrl
    let reqBody = RequestBodyLBS $ encode payload
    let request = initRequest {method = "PATCH"} {requestBody = reqBody}
    response <- catch
        (httpLbs request manager)
        (\(_ :: HttpException)-> do
            initPostReq <- parseUrl $ unpack url
            let requestPost = initPostReq {method = "POST"} {requestBody = reqBody}
            catch
                (httpLbs requestPost manager)
                (\ (x :: HttpException)-> do
                    lift $ printf "failed to post %s because of %s\n"
                           (unpack url)
                           (show x)
                    mzero))

{'fraction_non_alphanumeric': 0.09236018033386134, 'fraction_numerical': 0.0017058608504934812, 'mean_word_length': 2.7006311992786296, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 40, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 2, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6841375', 'n_tokens_mistral': 2496, 'n_tokens_neox': 2409, 'n_words': 876}