hlint pass

src/HolyProject.hs

@@ -31,6 +31,9 @@ import Control.Concurrent
 -- Get external file of package
 import Paths_holy_project
 
+import Data.Maybe                   (fromMaybe)
+import Control.Monad                (void)
+
 -- | Record containing all information to initialize a project
 data Project = Project {
       projectName :: String
@@ -73,9 +76,8 @@ holyStarter = do
     (name,email) <- getNameAndMailFromGitConfig
     earlyhint <- newEmptyMVar
     maybe   (putMVar earlyhint Nothing) -- if no email found put Nothing
-            (\hintmail -> do            -- in the other case ask the github API
+            (\hintmail ->               -- in the other case ask the github API
-                forkIO (putMVar earlyhint =<< searchGHUser hintmail)
+                void (forkIO (putMVar earlyhint =<< searchGHUser hintmail)))
-                >> return ())
             email
     project <- ask "project name" Nothing
     ioassert (checkProjectName project)
@@ -84,7 +86,7 @@ holyStarter = do
         modulename  = capitalize project
     in_author       <- ask "name" name
     in_email        <- ask "email" email
-    ghUserHint      <- if (maybe "" id email) /= in_email
+    ghUserHint      <- if fromMaybe "" email /= in_email
                             then searchGHUser in_email
                             else takeMVar earlyhint
     in_ghaccount    <- ask "github account" ghUserHint
@@ -97,7 +99,8 @@ holyStarter = do
 -- | Simply return the current year as String
 getCurrentYear :: IO String
 getCurrentYear = do
-    (current_year,_,_) <- getCurrentTime >>= return . toGregorian . utctDay
+    -- (current_year,_,_) <- getCurrentTime >>= return . toGregorian . utctDay
+    (current_year,_,_) <- fmap (toGregorian . utctDay) getCurrentTime
     return (show current_year)
 
 -- | Show an introduction test
@@ -142,7 +145,7 @@ createProject p = do
     let context = mkGenericContext p
     -- Check if the directory doesn't already exists
     dirExists <- doesDirectoryExist (projectName p)
-    ioassert (not dirExists) ((projectName p) ++ " directory already exists")
+    ioassert (not dirExists) (projectName p ++ " directory already exists")
     -- Create the directory and go into it
     createDirectory (projectName p)
     setCurrentDirectory (projectName p)
@@ -164,25 +167,25 @@ createProject p = do
           , "interact"
           )
         , ( "project.cabal"
-          , (projectName p) ++ ".cabal"
+          , projectName p ++ ".cabal"
           )
         , ( "src/Main.hs"
           , "src"  </> "Main.hs"
           )
         , ( "src/ModuleName.hs"
-          , "src"  </> ((moduleName p)++".hs")
+          , "src"  </> (moduleName p++".hs")
           )
         , ( "src/ModuleName/Coconut.hs"
-          , "src"  </> (moduleName p) </> "Coconut.hs"
+          , "src"  </> moduleName p </> "Coconut.hs"
           )
         , ( "src/ModuleName/Swallow.hs"
-          , "src"  </> (moduleName p) </> "Swallow.hs"
+          , "src"  </> moduleName p </> "Swallow.hs"
           )
         , ( "test/ModuleName/Coconut/Test.hs"
-          , "test" </> (moduleName p) </> "Coconut" </> "Test.hs"
+          , "test" </> moduleName p </> "Coconut" </> "Test.hs"
           )
         , ( "test/ModuleName/Swallow/Test.hs"
-          , "test" </> (moduleName p) </> "Swallow" </> "Test.hs"
+          , "test" </> moduleName p </> "Swallow" </> "Test.hs"
           )
         , ( "test/Test.hs"
           , "test" </> "Test.hs"
@@ -195,5 +198,5 @@ createProject p = do
     _ <- system "cabal sandbox init"
     _ <- system "cabal install"
     _ <- system "cabal test"
-    _ <- system $ "./.cabal-sandbox/bin/test-" ++ (projectName p)
+    _ <- system $ "./.cabal-sandbox/bin/test-" ++ projectName p
     return ()

src/HolyProject/GitConfig.hs

@@ -23,7 +23,7 @@ safeReadGitConfig = do
                  (do
                     home <- getEnv "HOME"
                     LZ.readFile $ home ++ "/.gitconfig" )
-    return $ either (const (LZ.empty)) id e
+    return $ either (const LZ.empty) id e
 
 -- | Returns the name and email from the content of a .gitconfig file
 -- almost equivalent to the two zsh lines:
@@ -58,7 +58,7 @@ firstJust l = case dropWhile (==Nothing) l of
 getValueForKey :: String            -- key
                   -> [LZ.ByteString] -- line of words
                   -> Maybe String    -- the value if found
-getValueForKey el (n:e:xs) = if (n == (LZ.pack el)) && (e == (LZ.pack "="))
+getValueForKey el (n:e:xs) = if (n == LZ.pack el) && (e == LZ.pack "=")
                         then Just (LZ.unpack (LZ.unwords xs))
                         else Nothing
 getValueForKey _ _ = Nothing

src/HolyProject/GithubAPI.hs

@@ -11,16 +11,14 @@ import Control.Lens.Aeson
 import Data.Aeson.Encode            (fromValue)
 import qualified Data.Text.Lazy as TLZ
 import qualified Data.Text.Lazy.Builder as TLB
+import Control.Monad                ((<=<))
 
 -- | make a simple http request but add a user agent to the HTTP header
 simpleHTTPWithUserAgent :: String -> IO LZ.ByteString
 simpleHTTPWithUserAgent url = do
     r  <- parseUrl url
     let request = r { requestHeaders =  [ ("User-Agent","HTTP-Conduit") ] }
-    body <- withManager $ \manager -> do
+    withManager $ (return.responseBody) <=< httpLbs request
-                response <- httpLbs request manager
-                return $ responseBody response
-    return body
 
 -- | Ask the github API
 -- A strange behaviour you HAVE TO add a User-Agent in your header.
@@ -30,7 +28,7 @@ searchGHUser ""    = return Nothing
 searchGHUser email = do
     let url = "https://api.github.com/search/users?q=" ++ email
     body <- simpleHTTPWithUserAgent url
-    login <- return $ body ^? key "items" . nth 0 . key "login"
+    let login = body ^? key "items" . nth 0 . key "login"
     return $ fmap jsonValueToString login
     where
         jsonValueToString = TLZ.unpack . TLB.toLazyText . fromValue

src/HolyProject/MontyPython.hs

@@ -7,7 +7,7 @@ where
 -- Console read write with colors
 import System.Console.ANSI
 import System.IO                    (hFlush, stdout)
-import Data.Maybe                   (fromJust)
+import Data.Maybe                   (fromJust,isJust)
 
 -- | bridgekeeper speak
 bk :: String -> IO ()
@@ -31,12 +31,12 @@ ask ::  String          -- ^ What? "name" for example
         -> IO String
 ask info hint = do
     bk $ "What is your " ++ info ++ "?" ++
-         (maybe "" (\h -> " ("++h++")") hint)
+         maybe "" (\h -> " ("++h++")") hint
     putStr "> "
     hFlush stdout
     answer <- getLine
     putStrLn ""
-    return $ if (answer == "") && (hint /= Nothing)
+    return $ if (answer == "") && isJust hint
                 then fromJust hint
                 else answer
 

src/HolyProject/StringUtils.hs

@@ -6,23 +6,23 @@ module HolyProject.StringUtils
 
 -- Project name manipulation
 import Data.Char                    (toUpper,toLower,isLetter,isNumber)
-import Data.List                    (intersperse)
+import Data.List                    (intercalate)
 import Data.List.Split              (splitOneOf)
 
 -- | transform a chain like "Holy project" in "holy-project"
 projectNameFromString :: String -> String
-projectNameFromString str = concat $ intersperse "-" (splitOneOf " -" (map toLower str))
+projectNameFromString str = intercalate "-" (splitOneOf " -" (map toLower str))
 
 -- | transform a chain like "Holy project" in "HolyProject"
 capitalize :: String -> String
-capitalize str = concat (map capitalizeWord (splitOneOf " -" str))
+capitalize str = concatMap capitalizeWord (splitOneOf " -" str)
     where
         capitalizeWord :: String -> String
-        capitalizeWord (x:xs)   = (toUpper x):map toLower xs
+        capitalizeWord (x:xs)   = toUpper x:map toLower xs
         capitalizeWord  _       = []
 
 -- | verify if a project name is conform
 checkProjectName :: String -> Bool
 checkProjectName [] = False
-checkProjectName str = all (\c -> (isLetter c)||(isNumber c)||(c=='-')||(c==' ')) str
+checkProjectName str = all (\c -> isLetter c || isNumber c || c=='-' || c==' ' ) str
 

test/HolyProject/StringUtils/Test.hs

@@ -1,7 +1,7 @@
 module HolyProject.StringUtils.Test
 ( stringUtilsSuite
 ) where
-import              Data.Char                       (isControl,isSymbol)
+import              Data.Char                       (isPrint,isSymbol)
 import              Test.Tasty                      (testGroup, TestTree)
 import              Test.Tasty.HUnit
 import              Test.Tasty.SmallCheck           (forAll)
@@ -10,6 +10,7 @@ import qualified    Test.Tasty.QuickCheck       as  QC
 import              Test.SmallCheck.Series          (Serial)
 import              HolyProject.StringUtils
 
+-- | Test with QuickCheck and SmallCheck
 tp name prop = testGroup name
     [ QC.testProperty "QC" prop
     , SC.testProperty "SC" prop
@@ -22,15 +23,15 @@ stringUtilsSuite = testGroup "StringUtils"
     , SC.testProperty "capitalize idempotent" $
          deeperIdempotent capitalize
     , tp "no space in project name" $
-         \s -> dropWhile (/=' ') (projectNameFromString s) == []
+         \s -> ' ' `notElem` projectNameFromString s
     , tp "no space in capitalized name" $
-         \s -> dropWhile (/=' ') (capitalize s) == []
+         \s -> ' ' `notElem` capitalize s
     , tp "no dash in capitalized name" $
-            \s -> dropWhile (/='-') (capitalize s) == []
+            \s -> '-' `notElem` capitalize s
     , tp "no control char" $
-        \s -> if (s /= "") && (checkProjectName s == True) then (all (not . isControl) s) else True
+        \s -> not (checkProjectName s) || all isPrint s
     , tp "no symbol char" $
-        \s -> if (s /= "") && (checkProjectName s == True) then (all (not . isSymbol) s) else True
+        \s -> not (checkProjectName s) || all (not . isSymbol) s
     , testCase "doesn't accept empty project name" $
             checkProjectName "" @=? False
     ]