Change the logic of toml files, refactor coloring

kowainik · chshersh · May 25, 2018 · May 23, 2018 · May 24, 2018 · May 24, 2018
commit f9444fc4ce1d1fd9cae8910a5751daff03a95130
diff --git a/README.md b/README.md
@@ -74,17 +74,17 @@ Here is the list of the options that could be configured for your needs:
               If not specified it would be asked during each run of the `summoner`.
 * `bscript` – `true` if you want to include [build script](#build-script) by default,
               `false` if you don't. If not specified it would be asked during each run of the `summoner`.
-* `lib` – `true` if you want to create `src` folder by default,
+* `lib` – `true` if you want to create `src` folder with dummy `Lib.hs` file and library target by default,
           `false` if you don't. If not specified it would be asked during each run of the `summoner`.
-* `exe` – `true` if you want to create `app` folder by default,
+* `exe` – `true` if you want to create `app` folder with dummy `Main.hs` file and executable target by default,
           `false` if you don't. If not specified it would be asked during each run of the `summoner`.
-* `test` – `true` if you want to create `test` folder by default,
+* `test` – `true` if you want to create `test` folder with dummy `Spec.hs` file and test target by default,
           `false` if you don't. If not specified it would be asked during each run of the `summoner`.
-* `bench` – `true` if you want to create `benchmark` folder by default with `gauge` library usage,
+* `bench` – `true` if you want to create `benchmark` folder  with `Main.hs` file with dummy `gauge` library usage example by default,
           `false` if you don't. If not specified it would be asked during each run of the `summoner`.
 
 
-See example of [configuration for projects of `Kowainik` organization]().
+See example of [configuration for projects of `Kowainik` organization](https://github.com/kowainik/org/blob/master/summoner.toml).
 
 
 By default the `summoner` will look for the configuration file (`summoner.toml`) in home directory.

diff --git a/src/Summoner/Ansi.hs b/src/Summoner/Ansi.hs
@@ -10,11 +10,13 @@ module Summoner.Ansi
        , successMessage
        , warningMessage
        , errorMessage
+       , infoMessage
+       , skipMessage
        ) where
 
 import Data.Semigroup (Semigroup (..))
 import Data.Text (Text)
-import System.Console.ANSI (Color (Blue, Green, Red, Yellow), ColorIntensity (Vivid),
+import System.Console.ANSI (Color (Blue, Cyan, Green, Red, Yellow), ColorIntensity (Vivid),
                             ConsoleIntensity (BoldIntensity), ConsoleLayer (Foreground),
                             SGR (Reset, SetColor, SetConsoleIntensity), setSGR)
 import System.IO (hFlush, stdout)
@@ -63,7 +65,9 @@ colorMessage color message = do
     T.putStrLn $ "  " <> message
     reset
 
-errorMessage, warningMessage, successMessage :: Text -> IO ()
+errorMessage, warningMessage, successMessage, infoMessage, skipMessage :: Text -> IO ()
 errorMessage   = colorMessage Red
 warningMessage = colorMessage Yellow
 successMessage = colorMessage Green
+infoMessage    = colorMessage Blue
+skipMessage    = colorMessage Cyan
diff --git a/src/Summoner/CLI.hs b/src/Summoner/CLI.hs
@@ -1,26 +1,27 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE QuasiQuotes   #-}
+{-# LANGUAGE TupleSections #-}
 
 -- | This module contains functions and data types to parse CLI inputs.
 
 module Summoner.CLI
        ( summon
        ) where
 
-import Data.Foldable (fold)
+import Data.Foldable (fold, for_)
 import Data.Semigroup (Semigroup (..))
 import Data.Text (Text)
 import NeatInterpolation (text)
 import Options.Applicative (Parser, ParserInfo, command, execParser, flag, fullDesc, help, helper,
                             info, infoFooter, infoHeader, long, metavar, optional, progDesc, short,
                             strArgument, strOption, subparser)
 import Options.Applicative.Help.Chunk (stringChunk)
-import System.Directory (doesFileExist, getHomeDirectory)
-import System.FilePath ((</>))
+import System.Directory (doesFileExist)
+import System.Exit (exitFailure)
 
-import Summoner.Ansi (boldText)
+import Summoner.Ansi (boldText, errorMessage, infoMessage, warningMessage)
 import Summoner.Config (ConfigP (..), PartialConfig, defaultConfig, finalise, loadFileConfig)
-import Summoner.Default (endLine)
+import Summoner.Default (defaultConfigFile, endLine)
 import Summoner.Project (generateProject)
 import Summoner.ProjectData (Decision (..))
 import Summoner.Validation (Validation (..))
@@ -37,20 +38,30 @@ summon = execParser prsr >>= runWithOptions
 -- | Run 'hs-init' with cli options
 runWithOptions :: InitOpts -> IO ()
 runWithOptions (InitOpts projectName cliConfig maybeFile) = do
-    file <- case maybeFile of
-        Nothing -> (</> "summoner.toml") <$> getHomeDirectory
-        Just x  -> pure x
+    (isDefault, file) <- case maybeFile of
+        Nothing -> (True,) <$> defaultConfigFile
+        Just x  -> pure (False, x)
     isFile <- doesFileExist file
     fileConfig <-
         if isFile
-        then loadFileConfig file
-        else pure mempty
+        then do
+            infoMessage $ "Configurations from " <> T.pack file <> " will be used."
+            loadFileConfig file
+        else  if isDefault
+              then do
+                  warningMessage "Default config file is missing."
+                  pure mempty
+              else do
+                  errorMessage $ "Specified configuration file " <> T.pack file <> " is not found."
+                  exitFailure
     -- union all possible configs
     let unionConfig = defaultConfig <> fileConfig <> cliConfig
     -- get the final config
-    let finalConfig = case finalise unionConfig of
-             Failure msgs -> error $ T.unpack $ T.intercalate "\n" msgs
-             Success c    -> c
+    finalConfig <- case finalise unionConfig of
+             Failure msgs -> do
+                 for_ msgs $ \msg -> errorMessage msg
+                 exitFailure
+             Success c    ->  pure c
     -- Generate the project.
     generateProject projectName finalConfig
 

diff --git a/src/Summoner/Default.hs b/src/Summoner/Default.hs
@@ -2,12 +2,16 @@
 
 module Summoner.Default
        ( defaultGHC
+       , defaultTomlFile
+       , defaultConfigFile
        , currentYear
        , endLine
        ) where
 
 import Data.Text (Text)
 import Data.Time (getCurrentTime, toGregorian, utctDay)
+import System.Directory (getHomeDirectory)
+import System.FilePath ((</>))
 
 import Summoner.ProjectData (GhcVer (Ghc822))
 
@@ -20,6 +24,12 @@ import qualified Data.Text as T
 defaultGHC :: GhcVer
 defaultGHC = Ghc822
 
+defaultTomlFile :: String
+defaultTomlFile = "summoner.toml"
+
+defaultConfigFile :: IO FilePath
+defaultConfigFile = (</> defaultTomlFile) <$> getHomeDirectory
+
 currentYear :: IO Text
 currentYear = do
     now <- getCurrentTime

diff --git a/src/Summoner/Project.hs b/src/Summoner/Project.hs
@@ -16,7 +16,7 @@ import NeatInterpolation (text)
 import System.Info (os)
 import System.Process (readProcess)
 
-import Summoner.Ansi (successMessage, warningMessage)
+import Summoner.Ansi (infoMessage, skipMessage, successMessage)
 import Summoner.Config (Config, ConfigP (..))
 import Summoner.Default (currentYear, defaultGHC)
 import Summoner.License (License (..), customizeLicense, githubLicenseQueryNames, licenseNames)
@@ -42,7 +42,7 @@ decisionToBool decision target = case decision of
 
 trueMessage, falseMessage :: Text -> IO Bool
 trueMessage  target = True  <$ successMessage (T.toTitle target <> " will be added to the project")
-falseMessage target = False <$ warningMessage (T.toTitle target <> " won't be added to the project")
+falseMessage target = False <$ skipMessage (T.toTitle target <> " won't be added to the project")
 
 
 -- | Generate the project.
@@ -88,12 +88,12 @@ generateProject projectName Config{..} = do
     test   <- decisionToBool cTest "tests"
     bench  <- decisionToBool cBench "benchmarks"
 
-    T.putStrLn $ "Supported by 'summoner' GHCs: " <> T.intercalate " " (map showGhcVer supportedGhcVers)
     T.putStrLn $ "The project will be created with the latest resolver for default GHC-" <> showGhcVer defaultGHC
     testedVersions <- case cGhcVer of
-        [] -> queryManyRepeatOnFail
-            parseGhcVer
-            "Additionally you can specify versions of GHC to test with (space-separated): "
+        [] -> do
+            T.putStrLn "Additionally you can specify versions of GHC to test with (space-separated): "
+            infoMessage $ "Supported by 'summoner' GHCs: " <> T.intercalate " " (map showGhcVer supportedGhcVers)
+            queryManyRepeatOnFail parseGhcVer
         vers -> do
             T.putStrLn $ "Also these GHC versions will be added: " <> T.intercalate " " (map showGhcVer vers)
             pure vers

diff --git a/src/Summoner/Question.hs b/src/Summoner/Question.hs
@@ -18,7 +18,7 @@ import Data.Text (Text)
 import System.Directory (doesPathExist, getCurrentDirectory)
 import System.FilePath ((</>))
 
-import Summoner.Ansi (boldDefault, errorMessage, prompt, putStrFlush)
+import Summoner.Ansi (boldDefault, errorMessage, prompt, putStrFlush, warningMessage)
 
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -63,9 +63,8 @@ queryDef question defAnswer = do
     if | T.null answer -> pure defAnswer
        | otherwise     -> pure answer
 
-queryManyRepeatOnFail :: forall a . (Text -> Maybe a) -> Text -> IO [a]
-queryManyRepeatOnFail parser question = do
-    T.putStrLn question
+queryManyRepeatOnFail :: forall a . (Text -> Maybe a) -> IO [a]
+queryManyRepeatOnFail parser = do
     promptLoop
   where
     promptLoop :: IO [a]
@@ -97,7 +96,7 @@ checkUniqueName nm = do
     curPath <- getCurrentDirectory
     exist   <- doesPathExist $ curPath </> T.unpack nm
     if exist then do
-        errorMessage "Project with this name is already exist. Please choose another one"
+        warningMessage "Project with this name is already exist. Please choose another one"
         newNm <- query "Project name: "
         checkUniqueName newNm
     else

diff --git a/src/Summoner/Template.hs b/src/Summoner/Template.hs
@@ -67,7 +67,7 @@ createStackTemplate
         build-type:          Simple
         extra-doc-files:     README.md
         cabal-version:       1.24
-        testedWith:          $testedGhcs
+        tested-with:         $testedGhcs
         $endLine
         |]