Add quickchek part 1

.travis.yml

@@ -40,7 +40,7 @@ script:
  - cabal build --enable-tests
  - cabal test --enable-tests
  - cabal sdist
- - cabal haddock | grep "100%" | wc -l | grep "4"
+ - cabal haddock | grep "100%" | wc -l | grep -G "[45]" # Fixes issue with different haddock coverage with different ghc versions https://github.com/haskell/haddock/issues/123
  # There is a single Docker image, there are no variants for different versions of GHC
  - if [[ "$GHCVER" == "8.0.2" ]]; then docker build . -t hapistrano; docker run --rm hapistrano --version; fi
 

spec/System/HapistranoPropsSpec.hs

@@ -2,15 +2,13 @@ module System.HapistranoPropsSpec
   ( spec
   ) where
 
-import Data.Char (isSpace)
-import System.Hapistrano.Commands.Internal
-  ( mkGenericCommand
-  , quoteCmd
-  , trim
-  , unGenericCommand
-  )
-import Test.Hspec hiding (shouldBe, shouldReturn)
-import Test.QuickCheck
+import           Data.Char                           (isSpace)
+import           System.Hapistrano.Commands.Internal (mkGenericCommand,
+                                                      quoteCmd, trim,
+                                                      unGenericCommand)
+import           Test.Hspec                          hiding (shouldBe,
+                                                      shouldReturn)
+import           Test.QuickCheck
 
 spec :: Spec
 spec =
@@ -40,7 +38,7 @@ propQuote' str =
 -- | Is trimmed
 isTrimmed' :: String -> Bool
 isTrimmed' [] = True
-isTrimmed' [_] = True
+isTrimmed' [x] = not $ isSpace x
 isTrimmed' str =
   let a = not . isSpace $ head str
       b = not . isSpace $ last str
@@ -59,7 +57,7 @@ isCmdString :: String -> Bool
 isCmdString str = all ($str) [not . null, notElem '#', notElem '\n', isTrimmed']
 
 -- | Prop Generic Command
--- If the string does not contain # or \n, is trimmed and non null, the command should be created 
+-- If the string does not contain # or \n, is trimmed and non null, the command should be created
 propGenericCmd :: String -> Bool
 propGenericCmd str =
   if isCmdString str
@@ -82,6 +80,6 @@ trimGenerator =
 -- | Generic Command generator
 genericCmdGenerator :: Gen String
 genericCmdGenerator =
-  let strGen = listOf arbitraryUnicodeChar
+  let strGen = listOf $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ [' ', '#', '*', '/', '.']
    in frequency
         [(1, suchThat strGen isCmdString), (1, suchThat strGen (elem '#'))]

src/System/Hapistrano/Commands/Internal.hs

@@ -9,29 +9,28 @@
 --
 -- Collection of type safe shell commands that can be fed into
 -- 'System.Hapistrano.Core.runCommand'.
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE GADTs               #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 module System.Hapistrano.Commands.Internal where
 
-import Control.Monad.IO.Class
-import Data.Char (isSpace)
-import Data.List (dropWhileEnd)
-import Data.Maybe (catMaybes, fromJust, mapMaybe)
-import Data.Proxy
-import Numeric.Natural
-import Path
+import           Control.Monad.IO.Class
+import           Data.Char               (isSpace)
+import           Data.List               (dropWhileEnd)
+import           Data.Maybe              (catMaybes, fromJust, mapMaybe)
+import           Data.Proxy
+import           Numeric.Natural
+import           Path
 
-import System.Hapistrano.Types (TargetSystem(..))
+import           System.Hapistrano.Types (TargetSystem (..))
 
 ----------------------------------------------------------------------------
 -- Commands
 -- | Class for data types that represent shell commands in typed way.
-class Command a
+class Command a where
   -- | Type of result.
-  where
   type Result a :: *
   -- | How to render the command before feeding it into shell (possibly via
   -- SSH).
@@ -216,7 +215,7 @@ instance Command GitClone where
           else Nothing
       , Just
           (case src of
-             Left repoUrl -> repoUrl
+             Left repoUrl  -> repoUrl
              Right srcPath -> fromAbsDir srcPath)
       , Just (fromAbsDir dest)
       ]
@@ -290,5 +289,6 @@ quoteCmd str =
 trim :: String -> String
 trim = dropWhileEnd isSpace . dropWhile isSpace
 
+-- | Determines whether or not the target system is a Linux machine.
 isLinux :: TargetSystem -> Bool
 isLinux = (== GNULinux)

src/System/Hapistrano/Core.hs

@@ -9,8 +9,8 @@
 --
 -- Core Hapistrano functions that provide basis on which all the
 -- functionality is built.
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module System.Hapistrano.Core
@@ -88,10 +88,10 @@ execWithInheritStdout typedCmd = do
   let cmd = renderCommand typedCmd
   (prog, args) <- getProgAndArgs cmd
   void $ exec' cmd (readProcessWithExitCode' (SPT.proc prog args))
+    where
     -- | Prepares a process, reads @stdout@ and @stderr@ and returns exit code
     -- NOTE: @strdout@ and @stderr@ are empty string because we're writing
     -- the output to the parent.
-  where
     readProcessWithExitCode' ::
          ProcessConfig stdin stdoutIgnored stderrIgnored
       -> IO (ExitCode, String, String)
@@ -137,11 +137,11 @@ scp' src dest extraArgs = do
       portArg =
         case sshPort <$> configSshOptions of
           Nothing -> []
-          Just x -> ["-P", show x]
+          Just x  -> ["-P", show x]
       hostPrefix =
         case sshHost <$> configSshOptions of
           Nothing -> ""
-          Just x -> x ++ ":"
+          Just x  -> x ++ ":"
       args = extraArgs ++ portArg ++ [src, hostPrefix ++ dest]
   void
     (exec' (prog ++ " " ++ unwords args) (readProcessWithExitCode prog args ""))
@@ -160,7 +160,7 @@ exec' cmd readProcessOutput = do
       printableTime = formatTime defaultTimeLocale timeStampFormat time
       hostLabel =
         case configSshOptions of
-          Nothing -> "localhost"
+          Nothing              -> "localhost"
           Just SshOptions {..} -> sshHost ++ ":" ++ show sshPort
       hostInfo = colorizeString Blue $ putLine hostLabel
       timestampInfo = colorizeString Cyan ("[" ++ printableTime ++ "] INFO -- : $ ")
@@ -170,7 +170,7 @@ exec' cmd readProcessOutput = do
   unless (null stdout') . liftIO $ configPrint StdoutDest stdout'
   unless (null stderr') . liftIO $ configPrint StderrDest stderr'
   case exitCode' of
-    ExitSuccess -> return stdout'
+    ExitSuccess   -> return stdout'
     ExitFailure n -> failWith n Nothing
 
 -- | Put something “inside” a line, sort-of beautifully.