checking response to return 2xx
This commit is contained in:
parent
86d5adbc83
commit
0a055af3e2
56
src/Main.hs
56
src/Main.hs
|
@ -6,13 +6,13 @@ import System.Environment
|
|||
import Data.Time.Clock
|
||||
import Data.Time.Format
|
||||
import Data.Time.Clock.POSIX
|
||||
import Network.HTTP.Conduit (simpleHttp)
|
||||
import Network.HTTP.Conduit
|
||||
import Network.HTTP.Simple (getResponseStatusCode, getResponseBody)
|
||||
import Data.List.Split
|
||||
import Data.Algorithm.Diff
|
||||
import Data.Algorithm.DiffOutput
|
||||
import Data.ByteString.Lazy.UTF8 (toString)
|
||||
import System.IO
|
||||
|
||||
data GeneratorState = IsRunning | IsFinished
|
||||
deriving (Eq)
|
||||
|
||||
|
@ -52,28 +52,40 @@ genOutput (Just changes) time timecodeFile= do
|
|||
genOutput Nothing _ _ = return()
|
||||
|
||||
-- Returning fetched url as a string separated by \n
|
||||
fetchFile :: String -> IO [String]
|
||||
fetchFile :: String -> IO (Either String [String])
|
||||
fetchFile url = do
|
||||
html <- simpleHttp url
|
||||
return $ (splitOn ("\n")) . toString $ html
|
||||
request <- parseRequest url
|
||||
manager <- newManager tlsManagerSettings
|
||||
response <- httpLbs request manager
|
||||
let statusCode = getResponseStatusCode response
|
||||
if statusCode `div` 100 == 2 then do
|
||||
return $ Right ((splitOn ("\n")) . toString $ getResponseBody response)
|
||||
else do
|
||||
return $ Left (show statusCode)
|
||||
|
||||
|
||||
-- Main Loop
|
||||
timecodeGenerator :: GeneratorState -> [String] -> UTCTime -> String -> String -> IO ()
|
||||
timecodeGenerator IsFinished _ _ _ _ = return ()
|
||||
timecodeGenerator IsRunning prevFile time url timecodeFile = do
|
||||
newFile <- fetchFile url
|
||||
currTime <- getCurrentTime
|
||||
let changes = getChanges newFile prevFile
|
||||
let diffTime = myFormatDiffTime (currTime, time)
|
||||
fetched <- fetchFile url
|
||||
case fetched of
|
||||
Right newFile -> do
|
||||
currTime <- getCurrentTime
|
||||
let changes = getChanges newFile prevFile
|
||||
let diffTime = myFormatDiffTime (currTime, time)
|
||||
|
||||
genOutput changes diffTime timecodeFile
|
||||
-- Waiting for 1 second
|
||||
threadDelay 10000
|
||||
-- Creating a loop until `IsFinished`
|
||||
if showRunning newFile == IsRunning then
|
||||
timecodeGenerator IsRunning newFile time url timecodeFile
|
||||
else
|
||||
timecodeGenerator IsFinished newFile time url timecodeFile
|
||||
genOutput changes diffTime timecodeFile
|
||||
-- Waiting for 1 second
|
||||
threadDelay 10000
|
||||
-- Creating a loop until `IsFinished`
|
||||
if showRunning newFile == IsRunning then
|
||||
timecodeGenerator IsRunning newFile time url timecodeFile
|
||||
else
|
||||
timecodeGenerator IsFinished newFile time url timecodeFile
|
||||
Left err -> do
|
||||
print err
|
||||
timecodeGenerator IsRunning prevFile time url timecodeFile
|
||||
|
||||
-- Commandline arguments:
|
||||
-- 1. Link to markdown file
|
||||
|
@ -84,9 +96,13 @@ main = do
|
|||
let url:timecodeFile:xs = args
|
||||
time <- getCurrentTime
|
||||
file <- fetchFile url
|
||||
appendToFile timecodeFile $ "New Timecodes starts here \n "
|
||||
appendToFile timecodeFile $ show time
|
||||
timecodeGenerator IsRunning file time url timecodeFile
|
||||
case file of
|
||||
Left e -> do
|
||||
putStrLn $ (++) "Error: " $ show e
|
||||
Right file -> do
|
||||
appendToFile timecodeFile $ "New Timecodes starts here \n "
|
||||
appendToFile timecodeFile $ show time
|
||||
timecodeGenerator IsRunning file time url timecodeFile
|
||||
|
||||
--let url = "https://hd.socks.town/s/h0jnEJQWy/download"
|
||||
--let timecodeFile = "timecodes.md"
|
||||
|
|
Loading…
Reference in a new issue