Merge branch 'release/0.2.0'

.bin/brok

@@ -0,0 +1 @@
+stack build --test && stack install > /dev/null && ~/.local/bin/brok $@

.bin/build

@@ -1,14 +1,15 @@
-resolver="lts-13.6"
-ghcv="8.6.3"
+# stop on any errors
+set -e
 
+workDir=".stack-build"
 branch=$(git rev-parse --abbrev-ref HEAD)
 
 if [ $branch != "master" ]; then
     echo "\033[0;31mMust be on master branch\033[0m"
     exit
 fi
 
-if [ ! -d ".stack-work" ]; then
+if [ ! -d "$workDir" ]; then
     echo "\033[0;31mMust be run in project root\033[0m"
     exit
 fi
@@ -18,40 +19,58 @@ if [ -z "$1" ]; then
     exit
 fi
 
+# stash any changes
+git stash
+
+# check cabal build works
+cabal build
+
+if [ $? -ne 0 ]
+then
+    git stash pop
+    echo "\033[0;31mCabal build failed\033[0m"
+    exit
+fi
+
 # make sure latest changes pushed to github
 git push --all && git push --tags
 
 # clean out previous build attempts
-rm -rf .stack-work/install
+rm -rf "$workDir/install"
 
 # sort out releases directory
 rm -rf "releases/$1/brok"
 mkdir -p "releases/$1/brok"
 
 # Mac
-stack build --ghc-options -O3
+stack build --work-dir "$workDir" --ghc-options -O3
+
+strip "$(stack path --local-install-root --work-dir $workDir)/bin/brok" # remove tokens
 
-tar -czvf "releases/$1/brok-$1_x86-64-mac.tar.gz" --directory=".stack-work/install/x86_64-osx/$resolver/$ghcv/bin" "brok"
+tar -czvf "releases/$1/brok-$1_x86-64-mac.tar.gz" --directory="$(stack path --local-install-root --work-dir $workDir)/bin" "brok"
 
 
 # Linux
 stack docker pull
-stack build --docker --ghc-options -O3
+stack build --work-dir "$workDir" --docker --ghc-options -O3
 
-LINUX_DIR=$(ls .stack-work/install | grep linux)
+LINUX_FULL_PATH=$(find "$workDir" -path "*linux*" -and -path "*bin/brok")
+LINUX_PATH=${LINUX_FULL_PATH%"brok"}
 
-tar -czvf "releases/$1/brok-$1_x86-64-linux.tar.gz" --directory=".stack-work/install/$LINUX_DIR/$resolver/$ghcv/bin" "brok"
+strip "$LINUX_FULL_PATH" # remove tokens
+
+tar -czvf "releases/$1/brok-$1_x86-64-linux.tar.gz"  --directory="$LINUX_PATH" "brok"
 
 mkdir -p "releases/$1/brok/DEBIAN"
 mkdir -p "releases/$1/brok/usr/local/bin"
 
-cp ".stack-work/install/$LINUX_DIR/$resolver/$ghcv/bin/brok" "releases/$1/brok/usr/local/bin"
+cp "$LINUX_PATH/brok" "releases/$1/brok/usr/local/bin"
 
 echo "Package: brok
 Version: $1
 Maintainer: Mark Wales
 Architecture: amd64
-Description: Finds broken links in text files" > "releases/$1/brok/DEBIAN/control"
+Description: Find broken links in text documents" > "releases/$1/brok/DEBIAN/control"
 
 docker run -v "$PWD/releases/$1":/usr/src/app -w /usr/src/app debian dpkg-deb --build brok
 
@@ -63,11 +82,21 @@ rm -rf "releases/$1/brok"
 open "releases/$1"
 open "https://github.com/smallhadroncollider/brok/releases/new"
 
-echo "-
+echo "
+-
 
 ### Installation
 
 - Mac/Linux: download binary and place it in a directory in your \`\$PATH\` (e.g. \`/usr/local/bin\`)
-- Debian (including Ubuntu): download the \`.deb\` file and run \`dpkg -i brok-$1_x86-64-linux.deb\`" | pbcopy
+- Debian (including Ubuntu): download the \`.deb\` file and run \`dpkg -i brok-$1_x86-64-linux.deb\`. You may also need to install the \`libtinfo5\` package (\`sudo apt install libtinfo5\`)
+- Fedora: Run \`sudo dnf install ncurses-compat-libs\` then download and run binary as described above" | pbcopy
 
 echo "Release info copied to clipboard"
+
+
+# add to Hackage
+stack upload .
+
+
+# unstash
+git stash pop

.gitignore

@@ -1,4 +1,6 @@
 .stack-work/
+.stack-build/
+dist-newstyle/
 brok.cabal
 releases/
 /.brokdb

README.md

@@ -104,6 +104,10 @@ brok --only-failures test.md links.tex
 
 If you're using brök as part of a script then you should [redirect `stdout`](#basic-usage).
 
+### Colour Output
+
+By default the output uses bash colour codes. You can turn this off using the `--no-color` setting.
+
 
 ### Git Pre-Commit Hook
 

package.yaml

@@ -1,5 +1,5 @@
 name:                brok
-version:             0.1.7.0
+version:             0.2.0.0
 github:              "smallhadroncollider/brok"
 license:             BSD3
 author:              "Small Hadron Collider"

taskell.md → roadmap.md

@@ -42,3 +42,5 @@
     > Already used by HTTP-conduit, so may as well use it
 - Fixed InvalidURLException crash
 - Fixed issue with HEAD request returning a 404
+- Sees `https://` and `http://` as valid URLs
+- Sees `https://*` as a valid URL

src/Brok.hs

@@ -9,30 +9,32 @@ module Brok
 import ClassyPrelude
 
 import Data.FileEmbed (embedFile)
+import Data.Text.IO   (hPutStrLn)
 import System.Exit    (exitFailure, exitSuccess)
 
-import           Brok.IO.CLI       (errorMessage, header, replace)
+import           Brok.IO.CLI       (header, replace)
 import           Brok.IO.DB        (getCached, setCached)
 import           Brok.IO.Document  (readContent)
 import           Brok.IO.Http      (check)
 import           Brok.IO.Output    (output)
 import           Brok.Options      (parse)
 import           Brok.Parser.Links (links)
-import qualified Brok.Types.Config as C (Config, cache, files, ignore, interval, onlyFailures)
+import           Brok.Types.App    (App)
+import qualified Brok.Types.Config as C (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)
 
-go :: C.Config -> IO ()
-go config
+go :: App ()
+go = do
+    config <- ask
     -- read files
- = do
     content <- traverse (readContent . pathToResult) (C.files config)
     -- find links in each file
     let parsed = parseLinks links <$> content
     -- check cached successes
-    cached <- getCached (C.cache config)
+    cached <- getCached
     let uncached = cachedLinks cached . ignoredLinks (C.ignore config) <$> parsed
     -- check links in each file
     header "Checking URLs"
@@ -44,11 +46,12 @@ go config
     header "Results"
     anyErrors <- output (C.onlyFailures config) checked
     -- cache successes
-    setCached (C.cache config) $ getURL <$> filter isSuccess (concat (justLinks <$> checked))
+    setCached $ getURL <$> filter isSuccess (concat (justLinks <$> checked))
     -- exit with appropriate status code
-    if anyErrors
-        then void exitFailure
-        else void exitSuccess
+    lift $
+        if anyErrors
+            then void exitFailure
+            else void exitSuccess
 
 showHelp :: IO ()
 showHelp = putStr $ decodeUtf8 $(embedFile "template/usage.txt")
@@ -58,9 +61,9 @@ brok :: IO ()
 brok = do
     config <- parse <$> getArgs
     case config of
-        Right (Continue cnf) -> go cnf
+        Right (Continue cnf) -> runReaderT go cnf
         Right Help -> showHelp
         Left _ -> do
-            errorMessage "Invalid format"
+            hPutStrLn stderr "Invalid format"
             showHelp
             void exitFailure

src/Brok/IO/CLI.hs

@@ -5,67 +5,77 @@ module Brok.IO.CLI where
 
 import ClassyPrelude
 
+import Brok.Types.App      (App)
+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,
                             hCursorUpLine, hSetSGR)
 
-message :: Text -> IO ()
+setSGR :: Handle -> [SGR] -> App ()
+setSGR hndl settings = do
+    colourize <- not <$> asks noColor
+    when colourize $ lift (hSetSGR hndl settings)
+
+blank :: App ()
+blank = putStrLn ""
+
+message :: Text -> App ()
 message msg = do
-    hSetSGR stdout [SetColor Foreground Dull Blue]
-    hPutStrLn stdout msg
-    hSetSGR stdout [Reset]
+    setSGR stdout [SetColor Foreground Dull Blue]
+    putStrLn msg
+    setSGR stdout [Reset]
 
-mehssage :: Text -> IO ()
+mehssage :: Text -> App ()
 mehssage msg = do
-    hSetSGR stdout [SetColor Foreground Dull Yellow]
-    hPutStrLn stdout msg
-    hSetSGR stdout [Reset]
+    setSGR stdout [SetColor Foreground Dull Yellow]
+    putStrLn msg
+    setSGR stdout [Reset]
 
-header :: Text -> IO ()
+header :: Text -> App ()
 header msg = do
-    hSetSGR stdout [SetColor Foreground Dull Magenta]
-    hPutStrLn stdout $ "*** " ++ msg ++ " ***"
-    hSetSGR stdout [Reset]
+    setSGR stdout [SetColor Foreground Dull Magenta]
+    putStrLn $ "*** " ++ msg ++ " ***"
+    setSGR stdout [Reset]
 
-successMessage :: Text -> IO ()
+successMessage :: Text -> App ()
 successMessage msg = do
-    hSetSGR stdout [SetColor Foreground Dull Green]
-    hPutStrLn stdout msg
-    hSetSGR stdout [Reset]
+    setSGR stdout [SetColor Foreground Dull Green]
+    putStrLn msg
+    setSGR stdout [Reset]
 
-errorMessage :: Text -> IO ()
+errorMessage :: Text -> App ()
 errorMessage msg = do
-    hSetSGR stderr [SetColor Foreground Dull Red]
-    hPutStrLn stderr msg
-    hSetSGR stderr [Reset]
+    setSGR stderr [SetColor Foreground Dull Red]
+    lift $ hPutStrLn stderr msg
+    setSGR stderr [Reset]
 
-errors :: Text -> [Text] -> IO ()
+errors :: Text -> [Text] -> App ()
 errors _ [] = return ()
 errors msg missing = do
     errorMessage msg
-    hPutStrLn stderr ""
+    lift $ hPutStrLn stderr ""
     errorMessage (unlines $ ("- " ++) <$> missing)
 
-split :: Handle -> Color -> Text -> Text -> IO ()
+split :: Handle -> Color -> Text -> Text -> App ()
 split hdl color left right = do
-    hSetSGR hdl [SetColor Foreground Dull color]
-    hPutStr hdl left
-    hSetSGR hdl [Reset]
-    hPutStr hdl $ ": " ++ right
-    hPutStrLn hdl ""
+    setSGR hdl [SetColor Foreground Dull color]
+    lift $ hPutStr hdl left
+    setSGR hdl [Reset]
+    lift $ hPutStr hdl $ ": " ++ right
+    lift $ hPutStrLn hdl ""
 
-splitErr :: Text -> Text -> IO ()
+splitErr :: Text -> Text -> App ()
 splitErr = split stderr Red
 
-splitOut :: Text -> Text -> IO ()
+splitOut :: Text -> Text -> App ()
 splitOut = split stdout Green
 
-splitMeh :: Text -> Text -> IO ()
+splitMeh :: Text -> Text -> App ()
 splitMeh = split stdout Yellow
 
-replace :: Text -> IO ()
+replace :: Text -> App ()
 replace msg = do
-    hCursorUpLine stdout 1
-    hClearLine stdout
-    hPutStrLn stdout msg
+    lift $ hCursorUpLine stdout 1
+    lift $ hClearLine stdout
+    putStrLn msg

src/Brok/IO/DB.hs

@@ -12,48 +12,56 @@ import Data.Either           (fromRight)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import System.Directory      (doesFileExist)
 
-import Brok.Parser.DB  (db)
-import Brok.Types.Link (URL)
+import Brok.Parser.DB    (db)
+import Brok.Types.App    (App)
+import Brok.Types.Config (cache)
+import Brok.Types.URL    (URL)
 
 path :: String
 path = ".brokdb"
 
 -- time stuff
-removeOld :: Integer -> [(URL, Integer)] -> IO [(URL, Integer)]
+removeOld :: Integer -> [(URL, Integer)] -> App [(URL, Integer)]
 removeOld age cached = do
-    timestamp <- getPOSIXTime
+    timestamp <- lift getPOSIXTime
     return $ filter ((\val -> timestamp - val < fromInteger age) . fromInteger . snd) cached
 
-stamp :: URL -> IO (URL, Integer)
+stamp :: URL -> App (URL, Integer)
 stamp lnk = do
-    timestamp <- round <$> getPOSIXTime
+    timestamp <- lift $ round <$> getPOSIXTime
     return (lnk, timestamp)
 
 -- write db
 linkToText :: (URL, Integer) -> Text
 linkToText (lnk, int) = concat [lnk, " ", tshow int]
 
-write :: [(URL, Integer)] -> IO ()
+write :: [(URL, Integer)] -> App ()
 write links = writeFile path . encodeUtf8 . unlines $ linkToText <$> links
 
-setCached :: Maybe Integer -> [URL] -> IO ()
-setCached Nothing _ = return ()
-setCached (Just age) links = do
-    current <- load age
-    stamped <- traverse stamp links
-    write $ current ++ stamped
+setCached :: [URL] -> App ()
+setCached links = do
+    mAge <- asks cache
+    case mAge of
+        Nothing -> pure ()
+        Just age -> do
+            current <- load age
+            stamped <- traverse stamp links
+            write $ current ++ stamped
 
 -- read db
-read :: Integer -> FilePath -> IO [(URL, Integer)]
+read :: Integer -> FilePath -> App [(URL, Integer)]
 read age filepath = removeOld age =<< fromRight [] . db . decodeUtf8 <$> readFile filepath
 
-load :: Integer -> IO [(URL, Integer)]
+load :: Integer -> App [(URL, Integer)]
 load age = do
-    exists <- doesFileExist path
+    exists <- lift $ doesFileExist path
     if exists
         then read age path
         else return []
 
-getCached :: Maybe Integer -> IO [URL]
-getCached Nothing    = return []
-getCached (Just age) = (fst <$>) <$> load age
+getCached :: App [URL]
+getCached = do
+    mAge <- asks cache
+    case mAge of
+        Nothing    -> pure []
+        (Just age) -> (fst <$>) <$> load age