Skip to content

Instantly share code, notes, and snippets.

@lgastako
Last active September 27, 2020 08:32
Show Gist options
  • Save lgastako/f7465339214c6fde0fd75f4e488b447a to your computer and use it in GitHub Desktop.
Save lgastako/f7465339214c6fde0fd75f4e488b447a to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
module SideEffectsExample where
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Lazy
import Data.Generics.Labels
import Data.Time.Clock
import GHC.Generics
import System.Directory
import Text.Printf
data Config = Config
{ database :: String
, user :: String
, pass :: String
, slackWebhook :: String
, inFile :: FilePath
} deriving (Eq, Generic, Ord, Show)
data AppState = AppState
{ total :: Int
, done :: Int
, written :: Int
, started :: UTCTime
, lastLogged :: UTCTime
} deriving (Eq, Generic, Ord, Show)
main :: IO ()
main = do
config <- readConfig("conf.ini")
db <- connectTo "mysql://" (config ^. #database) (config ^. #user) (config ^. #pass)
slack <- newSlack $ config ^. #slackWebhook
t <- getCurrentTime
urls <- lines <$> readFile (config ^. #inFile)
let initState = AppState
{ total = length urls
, done = 0
, written = 0
, started = t
, lastLogged = t
}
finalState <- flip execStateT initState $
traverse (downloadNew $ config ^. #inFile) urls
putStrLn "Finished"
notify slack "#jobs" "Done processing" (config ^. #inFile)
downloadNew :: FilePath -> String -> StateT AppState IO ()
downloadNew inFile url = do
#done += 1
filePath <- getPathFor url
status <- checkStatus filePath
unless (status == Fresh) $ do
html <- download url
liftIO . writeFile filePath $ serialize (url, html)
#written += 1
ll <- use #lastLogged
tsa <- tenSecondsAgo
when (ll < tsa) $ do
tm <- liftIO getCurrentTime
#lastLogged .= tm
d <- use #done
t <- use #total
w <- use #written
let eta = computeEta tm d t
msg = printf "Done %d / %d, written %d, ETA: %s" d t w eta
liftIO $ putStrLn msg
saveStatusFor inFile msg
checkStatus :: MonadIO m => FilePath -> m FileStatus
checkStatus path = liftIO $ do
exists <- doesFileExist path
if exists
then do
fresh <- isFresh path
pure $ if fresh
then Fresh
else Stale
else pure DoesNotExist
-- ================================================================ --
data FileStatus
= DoesNotExist
| Stale
| Fresh
deriving (Eq, Ord, Show)
isFresh :: MonadIO m => FilePath -> m Bool
isFresh = undefined
notify :: MonadIO m => Slack -> String -> String -> FilePath -> m ()
notify = undefined
saveStatusFor :: FilePath -> String -> StateT AppState IO ()
saveStatusFor = undefined
computeEta :: UTCTime -> Int -> Int -> String
computeEta = undefined
download :: MonadIO m => String -> m String
download = undefined
getPathFor :: MonadIO m => String -> m FilePath
getPathFor = undefined
tenSecondsAgo :: MonadIO m => m UTCTime
tenSecondsAgo = undefined
serialize :: (String, String) -> String
serialize = undefined
-- ================================================================ --
data Db = Db
data Slack = Slack
newSlack :: String -> IO Slack
newSlack = undefined
connectTo :: String -> String -> String -> String -> IO Db
connectTo = undefined
readConfig :: FilePath -> IO Config
readConfig = undefined
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment