modularized

src/HolyProject.hs

@@ -1,18 +1,18 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 module HolyProject where
-import HolyProject.Swallow ()
+import HolyProject.GitConfig        ( getNameAndMailFromGitConfig)
-import HolyProject.Coconut ()
+import HolyProject.StringUtils      ( projectNameFromString
+                                    , capitalize
+                                    , checkProjectName)
+import HolyProject.GitHubAPI        ( searchGHUserFromEmail)
+import HolyProject.MontyPython      ( bk
+                                    , you
+                                    , ask
+                                    )
 
--- Project name manipulation
-import Data.Char                    (toUpper,toLower,isLetter,isNumber)
-import Data.List                    (intersperse)
-import Data.List.Split              (splitOneOf)
 -- Get current year for the License
 import Data.Time.Clock
 import Data.Time.Calendar
--- Console read write with colors
-import System.Console.ANSI
-import System.IO                    (hFlush, stdout)
 -- Hastache
 import Data.Data
 import Text.Hastache
@@ -26,22 +26,8 @@ import System.FilePath.Posix        (takeDirectory,(</>))
 import System.Cmd                   (system)
 -- Random error message :)
 import System.Random
---- Environment variable
-import System.Environment           (getEnv)
-import Data.Maybe                   (fromJust)
-import Control.Exception
-import System.IO.Error
-import Control.Monad                (guard)
--- HTTP request and JSON handling
-import Network.HTTP.Conduit
-import Control.Lens.Operators       ((^?))
-import Control.Lens.Aeson
-import Data.Aeson.Encode            (fromValue)
-import qualified Data.Text.Lazy as TLZ
-import qualified Data.Text.Lazy.Builder as TLB
 -- Fork
 import Control.Concurrent
-
 -- Get external file of package
 import Paths_holy_project
 
@@ -55,7 +41,7 @@ data Project = Project {
     , synopsis :: String
     , year :: String } deriving (Data, Typeable)
 
--- | Error message
+-- | Randomly choose an end scenario and then show a "serious" error message
 holyError :: String -> IO ()
 holyError str = do
     r <- randomIO
@@ -80,28 +66,15 @@ ioassert :: Bool -> String -> IO ()
 ioassert True _ = return ()
 ioassert False str = holyError str
 
--- | return the content of ~/.gitconfig if it exists
--- if the HOME environment variable is not set
--- or the file doesn't exists
--- We return an empty string
-safeReadGitConfig :: IO LZ.ByteString
-safeReadGitConfig = do
-    e <- tryJust (guard . isDoesNotExistError)
-                 (do
-                    home <- getEnv "HOME"
-                    LZ.readFile $ home ++ "/.gitconfig" )
-    return $ either (const (LZ.empty)) id e
-
 -- | Ask, questions and create the initial project
 holyStarter :: IO ()
 holyStarter = do
     intro
-    gitconfig <- safeReadGitConfig
+    (name,email) <- getNameAndMailFromGitConfig
     earlyhint <- newEmptyMVar
-    let (name,email) = getNameAndMail gitconfig
     maybe   (putMVar earlyhint Nothing) -- if no email found put Nothing
             (\hintmail -> do            -- in the other case ask the github API
-                forkIO (putMVar earlyhint =<< getGHUser hintmail)
+                forkIO (putMVar earlyhint =<< searchGHUserFromEmail hintmail)
                 >> return ())
             email
     project <- ask "project name" Nothing
@@ -112,7 +85,7 @@ holyStarter = do
     in_author       <- ask "name" name
     in_email        <- ask "email" email
     ghUserHint      <- if (maybe "" id email) /= in_email
-                            then getGHUser in_email
+                            then searchGHUserFromEmail in_email
                             else takeMVar earlyhint
     in_ghaccount    <- ask "github account" ghUserHint
     in_synopsis     <- ask "project in less than a dozen word?" Nothing
@@ -127,26 +100,6 @@ getCurrentYear = do
     (current_year,_,_) <- getCurrentTime >>= return . toGregorian . utctDay
     return (show current_year)
 
--- | bridgekeeper speak
-bk :: String -> IO ()
-bk str = colorPutStr Green ("Bridgekeeper: " ++ str ++ "\n")
--- | bridgekeeper speak without line return
-bkn :: String -> IO ()
-bkn str = colorPutStr Green ("Bridgekeeper: " ++ str)
--- | the user dialog
-you :: String -> IO ()
-you str = colorPutStr Yellow ("Bridgekeeper: " ++ str ++ "\n")
-
--- | show color
-colorPutStr :: Color -> String -> IO ()
-colorPutStr color str = do
-    setSGR  [ SetColor Foreground Dull color
-            , SetConsoleIntensity NormalIntensity
-            ]
-    putStr str
-    setSGR []
-
-
 -- | Show an introduction test
 intro :: IO ()
 intro = do
@@ -168,38 +121,6 @@ end = do
     putStrLn "Sir Bedevere: How do you know so much about swallows?"
     you "Well, you have to know these things when you're a king, you know."
 
--- | Ask for some info and returns it
-ask ::  String          -- ^ What? "name" for example
-        -> Maybe String -- ^ Default value
-        -> IO String
-ask info hint = do
-    bk $ "What is your " ++ info ++ "?" ++
-         (maybe "" (\h -> " ("++h++")") hint)
-    putStr "> "
-    hFlush stdout
-    answer <- getLine
-    putStrLn ""
-    return $ if (answer == "") && (hint /= Nothing)
-                then fromJust hint
-                else answer
-
--- | verify if a project name is conform
-checkProjectName :: String -> Bool
-checkProjectName [] = False
-checkProjectName str = all (\c -> (isLetter c)||(isNumber c)||(c=='-')||(c==' ')) str
-
--- | transform a chain like "Holy project" in "holy-project"
-projectNameFromString :: String -> String
-projectNameFromString str = concat $ intersperse "-" (splitOneOf " -" (map toLower str))
-
--- | transform a chain like "Holy project" in "HolyProject"
-capitalize :: String -> String
-capitalize str = concat (map capitalizeWord (splitOneOf " -" str))
-    where
-        capitalizeWord :: String -> String
-        capitalizeWord (x:xs)   = (toUpper x):map toLower xs
-        capitalizeWord  _       = []
-
 -- | This function use a Data file mustache template
 -- and a hastache context to write a destination file
 genFile :: MuContext IO -- ^ hastache context
@@ -273,66 +194,3 @@ createProject p = do
     _ <- system "cabal test"
     _ <- system $ "./.cabal-sandbox/bin/test-" ++ (projectName p)
     return ()
-
-
--- | Returns the name and email from the content of a .gitconfig file
--- almost equivalent to the two zsh lines:
---
--- > name="$(< ~/.gitconfig awk '$1 == name {shift 2; print}')"
--- > email="$(< ~/.gitconfig awk '$1 == email {shift 2; print}')"
---
--- But in Haskell it doesn't read the entire file.
--- The script after the first occurence of name and email.
-getNameAndMail :: LZ.ByteString -> (Maybe String,Maybe String)
-getNameAndMail gitConfigContent = (getFirstValueFor splitted "name",
-                                   getFirstValueFor splitted "email")
-    where
-        -- make lines of words
-        splitted :: [[LZ.ByteString]]
-        splitted = map LZ.words (LZ.lines gitConfigContent)
-
--- | Get the first line which start with
--- 'elem =' and return the third field (value)
-getFirstValueFor :: [[LZ.ByteString]] -> String -> Maybe String
-getFirstValueFor splitted keyname = firstJust (map (getValueForKey keyname) splitted)
-
--- | return the first Just value of a list of Maybe
-firstJust :: (Eq a) => [Maybe a] -> Maybe a
-firstJust l = case dropWhile (==Nothing) l of
-    [] -> Nothing
-    (j:_) -> j
-
--- | Given a line of words ("word1":"word2":rest)
--- getValue will return rest if word1 == key
--- 'elem =' or Nothing otherwise
-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 "="))
-                        then Just (LZ.unpack (LZ.unwords xs))
-                        else Nothing
-getValueForKey _ _ = Nothing
-
--- | 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
-                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.
--- It took me way too long to get this error
-getGHUser :: String -> IO (Maybe String)
-getGHUser ""    = return Nothing
-getGHUser email = do
-    let url = "https://api.github.com/search/users?q=" ++ email
-    body <- simpleHTTPWithUserAgent url
-    login <- return $ body ^? key "items" . nth 0 . key "login"
-    return $ fmap jsonValueToString login
-    where
-        jsonValueToString = TLZ.unpack . TLB.toLazyText . fromValue

src/HolyProject/GitConfig.hs

@@ -0,0 +1,65 @@
+module HolyProject.GitConfig
+( getNameAndMailFromGitConfig
+)
+where
+
+import qualified    Data.ByteString.Lazy.Char8 as   LZ
+import              Control.Monad                   (guard)
+import              Control.Exception
+import              System.IO.Error
+import              System.Environment              (getEnv)
+
+-- | Return name and email in gitconfig if found
+getNameAndMailFromGitConfig :: IO (Maybe String, Maybe String)
+getNameAndMailFromGitConfig = return . getNameAndMail =<< safeReadGitConfig
+
+-- | return the content of ~/.gitconfig if it exists
+-- if the HOME environment variable is not set
+-- or the file doesn't exists
+-- We return an empty string
+safeReadGitConfig :: IO LZ.ByteString
+safeReadGitConfig = do
+    e <- tryJust (guard . isDoesNotExistError)
+                 (do
+                    home <- getEnv "HOME"
+                    LZ.readFile $ home ++ "/.gitconfig" )
+    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:
+--
+-- > name="$(< ~/.gitconfig awk '$1 == name {shift 2; print}')"
+-- > email="$(< ~/.gitconfig awk '$1 == email {shift 2; print}')"
+--
+-- But in Haskell it doesn't read the entire file.
+-- The script after the first occurence of name and email.
+getNameAndMail :: LZ.ByteString -> (Maybe String,Maybe String)
+getNameAndMail gitConfigContent = (getFirstValueFor splitted "name",
+                                   getFirstValueFor splitted "email")
+    where
+        -- make lines of words
+        splitted :: [[LZ.ByteString]]
+        splitted = map LZ.words (LZ.lines gitConfigContent)
+
+-- | Get the first line which start with
+-- 'elem =' and return the third field (value)
+getFirstValueFor :: [[LZ.ByteString]] -> String -> Maybe String
+getFirstValueFor splitted keyname = firstJust (map (getValueForKey keyname) splitted)
+
+-- | return the first Just value of a list of Maybe
+firstJust :: (Eq a) => [Maybe a] -> Maybe a
+firstJust l = case dropWhile (==Nothing) l of
+    [] -> Nothing
+    (j:_) -> j
+
+-- | Given a line of words ("word1":"word2":rest)
+-- getValue will return rest if word1 == key
+-- 'elem =' or Nothing otherwise
+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 "="))
+                        then Just (LZ.unpack (LZ.unwords xs))
+                        else Nothing
+getValueForKey _ _ = Nothing
+

src/HolyProject/GitHubAPI.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HolyProject.GitHubAPI where
+
+import qualified Data.ByteString.Lazy.Char8 as  LZ
+-- HTTP request and JSON handling
+import Network.HTTP.Conduit
+import Control.Lens.Operators       ((^?))
+import Control.Lens.Aeson
+import Data.Aeson.Encode            (fromValue)
+import qualified Data.Text.Lazy as TLZ
+import qualified Data.Text.Lazy.Builder as TLB
+
+-- | 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
+                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.
+-- It took me way too long to get this error
+searchGHUserFromEmail :: String -> IO (Maybe String)
+searchGHUserFromEmail ""    = return Nothing
+searchGHUserFromEmail email = do
+    let url = "https://api.github.com/search/users?q=" ++ email
+    body <- simpleHTTPWithUserAgent url
+    login <- return $ body ^? key "items" . nth 0 . key "login"
+    return $ fmap jsonValueToString login
+    where
+        jsonValueToString = TLZ.unpack . TLB.toLazyText . fromValue

src/HolyProject/MontyPython.hs

@@ -0,0 +1,42 @@
+module HolyProject.MontyPython
+( bk
+, you
+, ask
+)
+where
+-- Console read write with colors
+import System.Console.ANSI
+import System.IO                    (hFlush, stdout)
+import Data.Maybe                   (fromJust)
+
+-- | bridgekeeper speak
+bk :: String -> IO ()
+bk str = colorPutStr Green ("Bridgekeeper: " ++ str ++ "\n")
+-- | the user dialog
+you :: String -> IO ()
+you str = colorPutStr Yellow ("Sir Yourself: " ++ str ++ "\n")
+
+-- | show color
+colorPutStr :: Color -> String -> IO ()
+colorPutStr color str = do
+    setSGR  [ SetColor Foreground Dull color
+            , SetConsoleIntensity NormalIntensity
+            ]
+    putStr str
+    setSGR []
+
+-- | Ask for some info and returns it
+ask ::  String          -- ^ What? "name" for example
+        -> Maybe String -- ^ Default value
+        -> IO String
+ask info hint = do
+    bk $ "What is your " ++ info ++ "?" ++
+         (maybe "" (\h -> " ("++h++")") hint)
+    putStr "> "
+    hFlush stdout
+    answer <- getLine
+    putStrLn ""
+    return $ if (answer == "") && (hint /= Nothing)
+                then fromJust hint
+                else answer
+

src/HolyProject/StringUtils.hs

@@ -0,0 +1,24 @@
+module HolyProject.StringUtils where
+
+-- Project name manipulation
+import Data.Char                    (toUpper,toLower,isLetter,isNumber)
+import Data.List                    (intersperse)
+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))
+
+-- | transform a chain like "Holy project" in "HolyProject"
+capitalize :: String -> String
+capitalize str = concat (map capitalizeWord (splitOneOf " -" str))
+    where
+        capitalizeWord :: String -> String
+        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
+