brok 1.0.0 → 1.1.0
raw patch · 16 files changed
+307/−251 lines, 16 filesdep +containersdep ~ansi-terminaldep ~attoparsecdep ~classy-prelude
Dependencies added: containers
Dependency ranges changed: ansi-terminal, attoparsec, classy-prelude, connection, directory, file-embed, http-client, http-client-tls, http-conduit, tasty, tasty-discover, tasty-expected-failure, tasty-hunit, template-haskell, text, time
Files
- README.md +15/−0
- brok.cabal +96/−86
- src/Brok.hs +15/−17
- src/Brok/IO/CLI.hs +5/−5
- src/Brok/IO/DB.hs +5/−5
- src/Brok/IO/Document.hs +6/−7
- src/Brok/IO/Http.hs +17/−17
- src/Brok/IO/Output.hs +16/−16
- src/Brok/Parser/Links.hs +4/−7
- src/Brok/Parser/Options.hs +3/−6
- src/Brok/Types/Document.hs +82/−0
- src/Brok/Types/Link.hs +16/−18
- src/Brok/Types/Result.hs +0/−65
- test/IO/HttpTest.hs +1/−1
- test/Parser/LinksTest.hs +25/−0
- test/Spec.hs +1/−1
README.md view
@@ -12,6 +12,21 @@ [Binaries for Mac and Linux are available](https://github.com/smallhadroncollider/brok/releases). Add the binary to a directory in your path (such as `/usr/local/bin`). +### Docker++To build the latest version:++```bash+docker build -t brok https://github.com/smallhadroncollider/brok.git+```++To run brök:++```bash+docker run brok+```++ ### Cabal If you have `cabal` installed:
brok.cabal view
@@ -1,98 +1,108 @@ cabal-version: 1.12-name: brok-version: 1.0.0-license: BSD3-license-file: LICENSE-copyright: 2019 Small Hadron Collider-maintainer: mark@smallhadroncollider.com-author: Small Hadron Collider-homepage: https://github.com/smallhadroncollider/brok#readme-bug-reports: https://github.com/smallhadroncollider/brok/issues-synopsis: Finds broken links in text files-description:- Please see the README on GitHub at <https://github.com/smallhadroncollider/brok#readme>-category: Command Line Tools-build-type: Simple++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: a2846eec6d580dbc7314cf74bde0da813eda37a800019693b7570794634eb8b9++name: brok+version: 1.1.0+synopsis: Finds broken links in text files+description: Please see the README on GitHub at <https://github.com/smallhadroncollider/brok#readme>+category: Command Line Tools+homepage: https://github.com/smallhadroncollider/brok#readme+bug-reports: https://github.com/smallhadroncollider/brok/issues+author: Small Hadron Collider+maintainer: mark@smallhadroncollider.com+copyright: 2019 Small Hadron Collider+license: BSD3+license-file: LICENSE+build-type: Simple extra-source-files: README.md template/usage.txt source-repository head- type: git- location: https://github.com/smallhadroncollider/brok+ type: git+ location: https://github.com/smallhadroncollider/brok library- exposed-modules:- Brok- Brok.IO.CLI- Brok.IO.DB- Brok.IO.Document- Brok.IO.Http- Brok.IO.Output- Brok.Options- Brok.Parser.Attoparsec- Brok.Parser.DB- Brok.Parser.Links- Brok.Parser.Options- Brok.Types.Brok- Brok.Types.Config- Brok.Types.Link- Brok.Types.Next- Brok.Types.Result- Brok.Types.URL- hs-source-dirs: src- other-modules:- Paths_brok- default-language: Haskell2010- default-extensions: OverloadedStrings NoImplicitPrelude- build-depends:- ansi-terminal >=0.10.3 && <0.11,- attoparsec >=0.13.2.4 && <0.14,- base >=4.7 && <5,- classy-prelude >=1.5.0 && <1.6,- connection >=0.3.1 && <0.4,- directory >=1.3.6.0 && <1.4,- file-embed >=0.0.11.2 && <0.1,- http-client >=0.6.4.1 && <0.7,- http-client-tls >=0.3.5.3 && <0.4,- http-conduit >=2.3.7.3 && <2.4,- template-haskell >=2.15.0.0 && <2.16,- text >=1.2.4.0 && <1.3,- time >=1.9.3 && <1.10+ exposed-modules:+ Brok+ Brok.IO.CLI+ Brok.IO.DB+ Brok.IO.Document+ Brok.IO.Http+ Brok.IO.Output+ Brok.Options+ Brok.Parser.Attoparsec+ Brok.Parser.DB+ Brok.Parser.Links+ Brok.Parser.Options+ Brok.Types.Brok+ Brok.Types.Config+ Brok.Types.Document+ Brok.Types.Link+ Brok.Types.Next+ Brok.Types.URL+ other-modules:+ Paths_brok+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings NoImplicitPrelude+ build-depends:+ ansi-terminal+ , attoparsec+ , base >=4.7 && <5+ , classy-prelude+ , connection+ , containers+ , directory+ , file-embed+ , http-client+ , http-client-tls+ , http-conduit+ , template-haskell+ , text+ , time+ default-language: Haskell2010 executable brok- main-is: Main.hs- hs-source-dirs: app- other-modules:- Paths_brok- default-language: Haskell2010- default-extensions: OverloadedStrings NoImplicitPrelude- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends:- base >=4.7 && <5,- brok -any,- classy-prelude >=1.5.0 && <1.6,- file-embed >=0.0.11.2 && <0.1+ main-is: Main.hs+ other-modules:+ Paths_brok+ hs-source-dirs:+ app+ default-extensions: OverloadedStrings NoImplicitPrelude+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , brok+ , classy-prelude+ , file-embed+ default-language: Haskell2010 test-suite brok-test- type: exitcode-stdio-1.0- main-is: Spec.hs- hs-source-dirs: test- other-modules:- IO.HttpTest- OptionsTest- Parser.DBTest- Parser.LinksTest- Paths_brok- default-language: Haskell2010- default-extensions: OverloadedStrings NoImplicitPrelude- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends:- base >=4.7 && <5,- brok -any,- classy-prelude >=1.5.0 && <1.6,- file-embed >=0.0.11.2 && <0.1,- tasty >=1.2.3 && <1.3,- tasty-discover >=4.2.1 && <4.3,- tasty-expected-failure >=0.11.1.2 && <0.12,- tasty-hunit >=0.10.0.2 && <0.11+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ IO.HttpTest+ OptionsTest+ Parser.DBTest+ Parser.LinksTest+ Paths_brok+ hs-source-dirs:+ test+ default-extensions: OverloadedStrings NoImplicitPrelude+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , brok+ , classy-prelude+ , file-embed+ , tasty+ , tasty-discover+ , tasty-expected-failure+ , tasty-hunit+ default-language: Haskell2010
src/Brok.hs view
@@ -16,38 +16,36 @@ 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 view
@@ -5,8 +5,8 @@ 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 @@ 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 @@ 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 view
@@ -13,8 +13,8 @@ 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 @@ 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 @@ 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 @@ exists <- lift $ doesFileExist path if exists then read age path- else return []+ else pure [] getCached :: Brok [URL] getCached = do
src/Brok/IO/Document.hs view
@@ -9,14 +9,13 @@ 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 view
@@ -16,10 +16,11 @@ 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 @@ 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 (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 view
@@ -8,17 +8,17 @@ 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 @@ 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 @@ 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 view
@@ -20,7 +20,7 @@ preQueryChars = "-._~:/#%@" queryBodyChars :: String-queryBodyChars = "-._~:/#%@!$&*+,;="+queryBodyChars = preQueryChars <> "!$&*+,;=" chars :: String -> Parser Char chars chrs = digit <|> letter <|> choice (char <$> chrs)@@ -34,7 +34,7 @@ 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 @@ -- 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 view
@@ -68,7 +68,7 @@ (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 @@ -- 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)
+ src/Brok/Types/Document.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Brok.Types.Document where++import ClassyPrelude++import Brok.IO.Http (check)+import Brok.Parser.Links (links)+import Brok.Types.Brok (Brok)+import Brok.Types.Link+import Brok.Types.URL (URL)+import Data.Map.Strict as M (empty, insert, (!?))++type TFilePath = Text++type Error = Text++data Phase+ = Content Text+ | NotFound+ | ParseError Error+ | Links [Link]+ deriving (Show, Eq)++data Document =+ Document TFilePath+ Phase+ deriving (Show, Eq)++type LDAcc a = (LinkDictionary, [a])++getPath :: Document -> TFilePath+getPath (Document path _) = path++notFound :: TFilePath -> Document+notFound path = Document path NotFound++withContent :: TFilePath -> Text -> Document+withContent path text = Document path (Content text)++parseLinks :: Document -> Document+parseLinks (Document path (Content text)) =+ case links text of+ Left err -> Document path (ParseError err)+ Right lnks -> Document path (Links $ urlToLink <$> lnks)+parseLinks result = result++findLinks :: ([URL] -> Link -> Link) -> [URL] -> Document -> Document+findLinks fn urls (Document path (Links lnks)) = Document path (Links $ fn urls <$> lnks)+findLinks _ _ result = result++cachedLinks :: [URL] -> Document -> Document+cachedLinks = findLinks cachedLink++ignoredLinks :: [URL] -> Document -> Document+ignoredLinks = findLinks ignoredLink++-- go over each link, building up a list of found links+checkLink :: LDAcc Link -> Link -> Brok (LDAcc Link)+checkLink (prev, lnks) (Link url UnresolvedLink) = do+ case prev !? url of+ Just result -> pure $ (prev, lnks <> [result])+ Nothing -> do+ result <- check (Link url UnresolvedLink)+ let newPrev = insert url result prev+ pure $ (newPrev, lnks <> [result])+checkLink (prev, lnks) lnk = pure $ (prev, lnks <> [lnk])++-- go over each document, building up a list of found links+checkDocument :: LDAcc Document -> Document -> Brok (LDAcc Document)+checkDocument (prev, documents) (Document path (Links lnks)) = do+ (newPrev, newLnks) <- foldlM checkLink (prev, []) lnks+ pure $ (newPrev, documents <> [Document path (Links newLnks)])+checkDocument (prev, documents) document = pure $ (prev, documents <> [document])++-- check links in all documents+checkLinks :: [Document] -> Brok [Document]+checkLinks documents = snd <$> foldlM checkDocument (M.empty, []) documents++justLinks :: Document -> [Link]+justLinks (Document _ (Links lnks)) = lnks+justLinks _ = []
src/Brok/Types/Link.hs view
@@ -4,11 +4,11 @@ import ClassyPrelude -import Brok.Types.Brok (Brok)-import Brok.Types.URL (URL)+import Brok.Types.URL (URL)+import qualified Data.Map.Strict as M (Map) data LinkType- = BareLink+ = UnresolvedLink | Cached | Ignored | Working Int@@ -22,33 +22,35 @@ LinkType deriving (Show, Eq) +type LinkDictionary = M.Map URL Link+ urlToLink :: URL -> Link-urlToLink url = Link url BareLink+urlToLink url = Link url UnresolvedLink getURL :: Link -> URL getURL (Link url _) = url working :: Link -> Int -> Link-working (Link url BareLink) code = Link url (Working code)-working lnk _ = lnk+working (Link url UnresolvedLink) code = Link url (Working code)+working lnk _ = lnk broken :: Link -> Int -> Link-broken (Link url BareLink) code = Link url (Broken code)-broken lnk _ = lnk+broken (Link url UnresolvedLink) code = Link url (Broken code)+broken lnk _ = lnk failure :: Link -> Link-failure (Link url BareLink) = Link url ConnectionFailure-failure lnk = lnk+failure (Link url UnresolvedLink) = Link url ConnectionFailure+failure lnk = lnk invalid :: Link -> Link-invalid (Link url BareLink) = Link url InvalidURL-invalid lnk = lnk+invalid (Link url UnresolvedLink) = Link url InvalidURL+invalid lnk = lnk findLink :: LinkType -> (URL -> URL -> Bool) -> [URL] -> Link -> Link-findLink lType fn urls (Link url BareLink) =+findLink lType fn urls (Link url UnresolvedLink) = case find (fn url) urls of Just _ -> Link url lType- Nothing -> Link url BareLink+ Nothing -> Link url UnresolvedLink findLink _ _ _ lnk = lnk cachedLink :: [URL] -> Link -> Link@@ -60,7 +62,3 @@ isSuccess :: Link -> Bool isSuccess (Link _ (Working _)) = True isSuccess _ = False--lmap :: (Link -> Brok Link) -> Link -> Brok Link-lmap fn (Link url BareLink) = fn (Link url BareLink)-lmap _ lnk = return lnk
− src/Brok/Types/Result.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Brok.Types.Result where--import ClassyPrelude--import Brok.Types.Brok (Brok)-import Brok.Types.Link-import Brok.Types.URL (URL)--type TFilePath = Text--type Error = Text--data ResultType- = BareResult- | Content Text- | NotFound- | ParseError Error- | Links [Link]- deriving (Show, Eq)--data Result =- Result TFilePath- ResultType- deriving (Show, Eq)--pathToResult :: TFilePath -> Result-pathToResult path = Result path BareResult--getPath :: Result -> TFilePath-getPath (Result path _) = path--notFound :: Result -> Result-notFound (Result path BareResult) = Result path NotFound-notFound result = result--setContent :: Result -> Text -> Result-setContent (Result path BareResult) text = Result path (Content text)-setContent result _ = result--parseLinks :: (Text -> Either Text [URL]) -> Result -> Result-parseLinks fn (Result path (Content text)) =- case fn text of- Left err -> Result path (ParseError err)- Right links -> Result path (Links $ urlToLink <$> links)-parseLinks _ result = result--findLinks :: ([URL] -> Link -> Link) -> [URL] -> Result -> Result-findLinks fn urls (Result path (Links links)) = Result path (Links $ fn urls <$> links)-findLinks _ _ result = result--cachedLinks :: [URL] -> Result -> Result-cachedLinks = findLinks cachedLink--ignoredLinks :: [URL] -> Result -> Result-ignoredLinks = findLinks ignoredLink--linkIOMap :: (Link -> Brok Link) -> Result -> Brok Result-linkIOMap fn (Result path (Links links)) = Result path . Links <$> traverse (lmap fn) links-linkIOMap _ result = pure result--justLinks :: Result -> [Link]-justLinks (Result _ (Links links)) = links-justLinks _ = []
test/IO/HttpTest.hs view
@@ -16,7 +16,7 @@ testLink :: Text -> IO Link testLink lnk = do manager <- mkManager False- runReaderT (check 0 (urlToLink lnk)) (mkApp defaultConfig manager)+ runReaderT (check (urlToLink lnk)) (mkApp defaultConfig manager) test_http :: TestTree test_http =
test/Parser/LinksTest.hs view
@@ -113,6 +113,31 @@ "Gives back google.com" (Right ["http://google.com"]) (links "testing http://google.com, here"))+ , expectFail $+ testCase+ "link with non-standard character in middle"+ (assertEqual+ "Gived back full link"+ (Right+ [ "https://img.shields.io/badge/made_out_of_awesome-✓-brightgreen.svg?style=flat-square"+ ])+ (links+ "https://img.shields.io/badge/made_out_of_awesome-✓-brightgreen.svg?style=flat-square"))+ , expectFail $+ testCase+ "link with full stop at end"+ (assertEqual+ "Gives back link without full-stop"+ (Right ["https://github.com/Seldaek/hidden-input"])+ (links+ "`Resources/bin/hiddeninput.exe` is a third party binary provided within this component. Find sources and license at https://github.com/Seldaek/hidden-input."))+ , expectFail $+ testCase+ "link with unicode in domain"+ (assertEqual+ "Gives back http://💩.la"+ (Right ["http://💩.la"])+ (links "http://💩.la")) ] , testGroup "multiple links"
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-}