<commit_before>{-# LANGUAGE OverloadedStrings #-}
module Main where

import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Control.Monad (join)
import Control.Monad.Identity (Identity(..))
import Data.Default (def)
import Data.Monoid (mempty)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import Strive hiding (map)
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified KML as K

import Config

main :: IO ()
main = do
    [port] <- getArgs
    run (read port) $ logger app

app :: Application
app req respond = case (requestMethod req, pathInfo req) of
    ("GET", []) -> respond $ responseFile status200 [("Content-Type", "text/html")] "index.html" Nothing
    ("GET", ["segments.kml"]) -> segmentsKmlAuth (queryString req) >>= respond
    ("GET", ["segmentsView.kml"]) -> segmentsViewKml (queryString req) >>= respond
    ("GET", _) -> respond $ responseNotFound
    (_, _) -> respond $ responseNotImplemented

segmentsKmlAuth q =
    case lookup "code" q of
        Nothing ->
            return $ responseFound $ B.pack $ buildAuthorizeUrl clientId (url ++ "segments.kml") def
        Just (Just code) -> do
            res <- exchangeToken clientId clientSecret (B.unpack code)
            case res of
                Left err -> return $ responseBadReq err
                Right res' -> return $ segmentsKml $ T.unpack $ get accessToken res'

segmentsKml token = responseKml $ K.netLinkKML "Strava Segments" href format
    where
        href = url ++ "segmentsView.kml"
        format = "south=[bboxSouth]&west=[bboxWest]&north=[bboxNorth]&east=[bboxEast]&token=" ++ token

segmentsViewKml =
    getParamsM ["south", "west", "north", "east", "token"] $ \[s, w, n, e, token] ->
        fmap (responseKml . segsToKml) $ exploreBbox token (rd s, rd w, rd n, rd e)
    where
        rd = read . B.unpack

exploreBbox token bbox = do
    client <- buildClient $ B.unpack token<commit_msg>Factor out generic oAuth function<commit_after>{-# LANGUAGE OverloadedStrings #-}
module Main where

import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Control.Monad (join)
import Control.Monad.Identity (Identity(..))
import Data.Default (def)
import Data.Monoid (mempty)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import Strive hiding (map)
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified KML as K

import Config

main :: IO ()
main = do
    [port] <- getArgs
    run (read port) $ logger app

app :: Application
app req respond = case (requestMethod req, pathInfo req) of
    ("GET", []) -> respond $ responseFile status200 [("Content-Type", "text/html")] "index.html" Nothing
    ("GET", ["segments.kml"]) -> oAuth def (url ++ "segments.kml") segmentsKml (queryString req) >>= respond
    ("GET", ["segmentsView.kml"]) -> segmentsViewKml (queryString req) >>= respond
    ("GET", _) -> respond $ responseNotFound
    (_, _) -> respond $ responseNotImplemented

oAuth opts pageUrl f q =
    case lookup "code" q of
        Nothing ->
            return $ responseFound $ B.pack $ buildAuthorizeUrl clientId pageUrl opts
        Just (Just code) -> do
            res <- exchangeToken clientId clientSecret (B.unpack code)
            case res of
                Left err -> return $ responseBadReq err
                Right res' -> return $ f $ T.unpack $ get accessToken res'

segmentsKml token = responseKml $ K.netLinkKML "Strava Segments" href format
    where
        href = url ++ "segmentsView.kml"
        format = "south=[bboxSouth]&west=[bboxWest]&north=[bboxNorth]&east=[bboxEast]&token=" ++ token

segmentsViewKml =
    getParamsM ["south", "west", "north", "east", "token"] $ \[s, w, n, e, token] ->
        fmap (responseKml . segsToKml) $ exploreBbox token (rd s, rd w, rd n, rd e)
    where
        rd = read . B.unpack

exploreBbox token bbox = do
    client <- buildClient $ B.unpack token
{'fraction_non_alphanumeric': 0.12326732673267327, 'fraction_numerical': 0.0024752475247524753, 'mean_word_length': 3.276190476190476, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, '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': '5113121', 'n_tokens_mistral': 1275, 'n_tokens_neox': 1242, 'n_words': 393}