Merge branch 'release/1.1.0'

package.yaml

@@ -1,5 +1,5 @@
 name:                brok
-version:             1.0.0
+version:             1.1.0
 github:              "smallhadroncollider/brok"
 license:             BSD3
 author:              "Small Hadron Collider"
@@ -34,6 +34,7 @@ library:
   - ansi-terminal
   - attoparsec
   - connection
+  - containers
   - directory
   - http-conduit
   - http-client

roadmap.md

@@ -6,6 +6,7 @@
 ## Features
 
 - Parallel HTTP fetch for separate domains
+- Add PDF support
 - Better --only-failures output
 - Cache length option should accept units: s, m, h, d - default to s
 - More detailed HttpException errors
@@ -16,8 +17,9 @@
 ## Bugs
 
 - Can't parse links containing single quote marks
+- URLs containing unicode characters won't parse
 - Fetching message sometimes goes to more than one line, so next line doesn't replace it (saveCursor/restoreCursor?)
-- Checks the same URL multiple times if in different files
+    > When a line is longer than the available width
 - Is an invalid URL an error?
     > Should an invalid URL count as an error? The parser shouldn't really pick up invalid URLs. But if it looks like one and fails then it is probably worth high-lighting.
 - Edge case: shouldn't delay if only a single URL being checked
@@ -44,3 +46,4 @@
 - Fixed issue with HEAD request returning a 404
 - Sees `https://` and `http://` as valid URLs
 - Sees `https://*` as a valid URL
+- Checks the same URL multiple times if in different files

src/Brok.hs

@@ -16,38 +16,36 @@ import           Data.Version               (showVersion)
 import           Language.Haskell.TH.Syntax (liftString)
 import qualified Paths_brok                 (version)
 
-import           Brok.IO.CLI       (header, replace)
-import           Brok.IO.DB        (getCached, setCached)
-import           Brok.IO.Document  (readContent)
-import           Brok.IO.Http      (check, mkManager)
-import           Brok.IO.Output    (output)
-import           Brok.Options      (parse)
-import           Brok.Parser.Links (links)
-import           Brok.Types.Brok   (Brok, appConfig, mkApp)
-import qualified Brok.Types.Config as C (checkCerts, files, ignore, interval, onlyFailures)
-import           Brok.Types.Link   (getURL, isSuccess)
-import           Brok.Types.Next   (Next (..))
-import           Brok.Types.Result (cachedLinks, ignoredLinks, justLinks, linkIOMap, parseLinks,
-                                    pathToResult)
+import           Brok.IO.CLI         (header, replace)
+import           Brok.IO.DB          (getCached, setCached)
+import           Brok.IO.Document    (readContent)
+import           Brok.IO.Http        (mkManager)
+import           Brok.IO.Output      (output)
+import           Brok.Options        (parse)
+import           Brok.Types.Brok     (Brok, appConfig, mkApp)
+import qualified Brok.Types.Config   as C (checkCerts, files, ignore, onlyFailures)
+import           Brok.Types.Document (cachedLinks, checkLinks, ignoredLinks, justLinks, parseLinks)
+import           Brok.Types.Link     (getURL, isSuccess)
+import           Brok.Types.Next     (Next (..))
 
 go :: Brok ()
 go = do
     config <- asks appConfig
     -- read files
-    content <- traverse (readContent . pathToResult) (C.files config)
+    content <- traverse readContent (C.files config)
     -- find links in each file
-    let parsed = parseLinks links <$> content
+    let parsed = parseLinks <$> content
     -- check cached successes
     cached <- getCached
     let uncached = cachedLinks cached . ignoredLinks (C.ignore config) <$> parsed
     -- check links in each file
     header "Checking URLs"
     putStrLn ""
-    checked <- traverse (linkIOMap (check (C.interval config))) uncached
+    checked <- checkLinks uncached
     replace "Fetching complete"
     -- display results
     putStrLn ""
-    header "Results"
+    header "Documents"
     anyErrors <- output (C.onlyFailures config) checked
     -- cache successes
     setCached $ getURL <$> filter isSuccess (concat (justLinks <$> checked))

src/Brok/IO/CLI.hs

@@ -5,8 +5,8 @@ module Brok.IO.CLI where
 
 import ClassyPrelude
 
-import Brok.Types.Config   (noColor)
 import Brok.Types.Brok     (Brok, appConfig)
+import Brok.Types.Config   (noColor)
 import Data.Text.IO        (hPutStr, hPutStrLn)
 import System.Console.ANSI (Color (Blue, Green, Magenta, Red, Yellow), ColorIntensity (Dull),
                             ConsoleLayer (Foreground), SGR (Reset, SetColor), hClearLine,
@@ -35,7 +35,7 @@ mehssage msg = do
 header :: Text -> Brok ()
 header msg = do
     setSGR stdout [SetColor Foreground Dull Magenta]
-    putStrLn $ "*** " ++ msg ++ " ***"
+    putStrLn $ "*** " <> msg <> " ***"
     setSGR stdout [Reset]
 
 successMessage :: Text -> Brok ()
@@ -51,18 +51,18 @@ errorMessage msg = do
     setSGR stderr [Reset]
 
 errors :: Text -> [Text] -> Brok ()
-errors _ [] = return ()
+errors _ [] = pure ()
 errors msg missing = do
     errorMessage msg
     lift $ hPutStrLn stderr ""
-    errorMessage (unlines $ ("- " ++) <$> missing)
+    errorMessage (unlines $ ("- " <>) <$> missing)
 
 split :: Handle -> Color -> Text -> Text -> Brok ()
 split hdl color left right = do
     setSGR hdl [SetColor Foreground Dull color]
     lift $ hPutStr hdl left
     setSGR hdl [Reset]
-    lift $ hPutStr hdl $ ": " ++ right
+    lift $ hPutStr hdl $ ": " <> right
     lift $ hPutStrLn hdl ""
 
 splitErr :: Text -> Text -> Brok ()

src/Brok/IO/DB.hs

@@ -13,8 +13,8 @@ import Data.Time.Clock.POSIX (getPOSIXTime)
 import System.Directory      (doesFileExist)
 
 import Brok.Parser.DB    (db)
-import Brok.Types.Config (cache)
 import Brok.Types.Brok   (Brok, appConfig)
+import Brok.Types.Config (cache)
 import Brok.Types.URL    (URL)
 
 path :: String
@@ -24,12 +24,12 @@ path = ".brokdb"
 removeOld :: Integer -> [(URL, Integer)] -> Brok [(URL, Integer)]
 removeOld age cached = do
     timestamp <- lift getPOSIXTime
-    return $ filter ((\val -> timestamp - val < fromInteger age) . fromInteger . snd) cached
+    pure $ filter ((\val -> timestamp - val < fromInteger age) . fromInteger . snd) cached
 
 stamp :: URL -> Brok (URL, Integer)
 stamp lnk = do
     timestamp <- lift $ round <$> getPOSIXTime
-    return (lnk, timestamp)
+    pure (lnk, timestamp)
 
 -- write db
 linkToText :: (URL, Integer) -> Text
@@ -46,7 +46,7 @@ setCached links = do
         Just age -> do
             current <- load age
             stamped <- traverse stamp links
-            write $ current ++ stamped
+            write $ current <> stamped
 
 -- read db
 read :: Integer -> FilePath -> Brok [(URL, Integer)]
@@ -57,7 +57,7 @@ load age = do
     exists <- lift $ doesFileExist path
     if exists
         then read age path
-        else return []
+        else pure []
 
 getCached :: Brok [URL]
 getCached = do

src/Brok/IO/Document.hs

@@ -9,14 +9,13 @@ import ClassyPrelude
 
 import System.Directory (doesFileExist)
 
-import Brok.Types.Brok    (Brok)
-import Brok.Types.Result
+import Brok.Types.Brok     (Brok)
+import Brok.Types.Document
 
-readContent :: Result -> Brok Result
-readContent result = do
-    let path = getPath result
+readContent :: TFilePath -> Brok Document
+readContent path = do
     let filepath = unpack path
     exists <- lift $ doesFileExist filepath
     if exists
-        then setContent result . decodeUtf8 <$> readFile filepath
-        else return $ notFound result
+        then withContent path . decodeUtf8 <$> readFile filepath
+        else pure $ notFound path

src/Brok/IO/Http.hs

@@ -16,10 +16,11 @@ import Network.HTTP.Client.TLS (mkManagerSettings)
 import Network.HTTP.Simple     (HttpException, HttpException (..), Request, addRequestHeader,
                                 getResponseStatusCode, parseRequest, setRequestMethod)
 
-import Brok.IO.CLI     (replace)
-import Brok.Types.Brok (Brok, appTLSManager)
+import Brok.IO.CLI       (replace)
+import Brok.Types.Brok   (Brok, appConfig, appTLSManager)
+import Brok.Types.Config (interval)
 import Brok.Types.Link
-import Brok.Types.URL  (URL)
+import Brok.Types.URL    (URL)
 
 type StatusCode = Either HttpException Int
 
@@ -32,25 +33,24 @@ mkManager checkCerts = do
 setHeaders :: Request -> Request
 setHeaders = addRequestHeader "User-Agent" "smallhadroncollider/brok"
 
-makeRequest :: Integer -> ByteString -> URL -> Brok StatusCode
-makeRequest delay method url = do
+makeRequest :: ByteString -> URL -> Brok StatusCode
+makeRequest method url = do
     manager <- asks appTLSManager
+    delay <- interval <$> asks appConfig
     lift . try $ do
         request <- setHeaders . setRequestMethod method <$> parseRequest (unpack url)
         threadDelay (fromIntegral delay * 1000) -- wait for a little while
         getResponseStatusCode <$> httpNoBody request manager
 
-tryWithGet :: Integer -> URL -> StatusCode -> Brok StatusCode
-tryWithGet delay url (Right code)
-    | code >= 400 = makeRequest delay "GET" url
-    | otherwise = return (Right code)
-tryWithGet delay url (Left (HttpExceptionRequest _ (InternalException _))) =
-    makeRequest delay "GET" url
-tryWithGet delay url (Left _) = makeRequest delay "GET" url
+tryWithGet :: URL -> StatusCode -> Brok StatusCode
+tryWithGet url (Right code)
+    | code >= 400 = makeRequest "GET" url
+    | otherwise = pure (Right code)
+tryWithGet url (Left (HttpExceptionRequest _ (InternalException _))) = makeRequest "GET" url
+tryWithGet url (Left _) = makeRequest "GET" url
 
-fetch :: Integer -> URL -> Brok StatusCode
-fetch delay url =
-    replace ("Fetching: " ++ url) >> makeRequest delay "HEAD" url >>= tryWithGet delay url
+fetch :: URL -> Brok StatusCode
+fetch url = replace ("Fetching: " <> url) >> makeRequest "HEAD" url >>= tryWithGet url
 
 codeToResponse :: Link -> StatusCode -> Link
 codeToResponse lnk (Right code)
@@ -59,5 +59,5 @@ codeToResponse lnk (Right code)
 codeToResponse lnk (Left (HttpExceptionRequest _ _)) = failure lnk
 codeToResponse lnk (Left (InvalidUrlException _ _)) = invalid lnk
 
-check :: Integer -> Link -> Brok Link
-check delay lnk = codeToResponse lnk <$> fetch delay (getURL lnk)
+check :: Link -> Brok Link
+check lnk = codeToResponse lnk <$> fetch (getURL lnk)

src/Brok/IO/Output.hs

@@ -8,17 +8,17 @@ module Brok.IO.Output
 import ClassyPrelude
 
 import Brok.IO.CLI
-import Brok.Types.Brok    (Brok)
+import Brok.Types.Brok     (Brok)
+import Brok.Types.Document
 import Brok.Types.Link
-import Brok.Types.Result
 
 -- output
 linkOutput :: Link -> Brok ()
-linkOutput (Link url BareLink)          = splitErr "- Failed (unknown)" url
-linkOutput (Link url Ignored)           = mehssage $ "- Ignored: " ++ url
+linkOutput (Link url UnresolvedLink)    = splitErr "- Failed (unknown)" url
+linkOutput (Link url Ignored)           = mehssage $ "- Ignored: " <> url
 linkOutput (Link url Cached)            = splitOut "- OK (cached)" url
-linkOutput (Link url (Working code))    = splitOut ("- OK (" ++ tshow code ++ ")") url
-linkOutput (Link url (Broken code))     = splitErr ("- Failed (" ++ tshow code ++ ")") url
+linkOutput (Link url (Working code))    = splitOut ("- OK (" <> tshow code <> ")") url
+linkOutput (Link url (Broken code))     = splitErr ("- Failed (" <> tshow code <> ")") url
 linkOutput (Link url ConnectionFailure) = splitErr "- Could not connect" url
 linkOutput (Link url InvalidURL)        = splitErr "- Invalid URL" url
 
@@ -31,17 +31,17 @@ statusError _                    = True
 outputPath :: TFilePath -> Text
 outputPath path = concat ["\n", "[", path, "]"]
 
-outputMap :: Bool -> Result -> Brok Bool
-outputMap _ (Result path NotFound) = do
+outputMap :: Bool -> Document -> Brok Bool
+outputMap _ (Document path NotFound) = do
     errorMessage $ outputPath path
     errorMessage "  - File not found"
-    return True
-outputMap _ (Result path (ParseError err)) = do
+    pure True
+outputMap _ (Document path (ParseError err)) = do
     errorMessage $ outputPath path
     errorMessage "  - Parse error:"
     errorMessage err
-    return True
-outputMap onlyFailures (Result path (Links links)) = do
+    pure True
+outputMap onlyFailures (Document path (Links links)) = do
     let errs = filter statusError links
     let anyErrs = not (null errs)
     if anyErrs
@@ -57,12 +57,12 @@ outputMap onlyFailures (Result path (Links links)) = do
                  if not (null links)
                      then traverse_ linkOutput links
                      else putStrLn "- No links found in file"
-    return anyErrs
-outputMap _ _ = return False
+    pure anyErrs
+outputMap _ _ = pure False
 
-output :: Bool -> [Result] -> Brok Bool
+output :: Bool -> [Document] -> Brok Bool
 output onlyFailures results = do
     errs <- traverse (outputMap onlyFailures) results
     let anyErrs = foldl' (||) False errs
     when (not anyErrs && onlyFailures) $ successMessage "All links working"
-    return anyErrs
+    pure anyErrs

src/Brok/Parser/Links.hs

@@ -20,7 +20,7 @@ preQueryChars :: String
 preQueryChars = "-._~:/#%@"
 
 queryBodyChars :: String
-queryBodyChars = "-._~:/#%@!$&*+,;="
+queryBodyChars = preQueryChars <> "!$&*+,;="
 
 chars :: String -> Parser Char
 chars chrs = digit <|> letter <|> choice (char <$> chrs)
@@ -34,7 +34,7 @@ part :: String -> Parser Text
 part str = concat <$> many1 (parens (part str) <|> manyChars (chars str))
 
 query :: Parser Text
-query = (++) <$> string "?" <*> part queryBodyChars
+query = (<>) <$> string "?" <*> part queryBodyChars
 
 url :: Parser Text
 url =
@@ -49,8 +49,5 @@ urls = nub . catMaybes <$> many1 ((Just <$> url) <|> noise)
 
 -- run parser
 links :: Text -> Either Text [URL]
-links "" = Right []
-links content =
-    case parseOnly urls content of
-        Right c -> Right c
-        Left e  -> Left $ tshow e
+links ""      = Right []
+links content = first tshow $ parseOnly urls content

src/Brok/Parser/Options.hs

@@ -68,7 +68,7 @@ arguments = do
             (noCacheP <|> cacheP <|> intervalP <|> ignoreP <|> noColorP <|> checkCertsP <|>
              onlyFailuresP)
     fls <- many1 fileP
-    return . optsToConfig $ opts ++ [Files fls]
+    pure . optsToConfig $ opts <> [Files fls]
 
 helpP :: Parser Next
 helpP = lexeme $ (string "--help" <|> string "-h") $> Help
@@ -81,8 +81,5 @@ next = helpP <|> versionP <|> (Continue <$> arguments)
 
 -- run parser
 options :: [Text] -> Either Text Next
-options [] = Left "No files provided"
-options content =
-    case parseOnly next (unlines content) of
-        Right c -> Right c
-        Left e  -> Left $ tshow e
+options []      = Left "No files provided"
+options content = first tshow $ parseOnly next (unlines content)