[#202] Bump up relude to 0.4.0

Add more documentation to the functions
kowainik · Nov 17, 2018 · 87c788f · 87c788f
1 parent 97066d2
commit 87c788f
Show file tree

Hide file tree

Showing 17 changed files with 171 additions and 116 deletions.
diff --git a/.travis.yml b/.travis.yml
@@ -92,7 +92,7 @@ script:
     else
       stack build --test --no-terminal
     fi
-  - curl https://raw.githubusercontent.com/kowainik/relude/bc23b0fe2c3699f5c202ed04222766dc0d789fd1/.hlint.yaml -o .hlint-relude.yaml
+  - curl https://raw.githubusercontent.com/kowainik/relude/988bbdd3a09df1159917012933780523644880e5/.hlint.yaml -o .hlint-relude.yaml
   - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint -h .hlint-relude.yaml src/ test/
 
 notifications:

diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -36,6 +36,9 @@
 * [#155](https://github.com/kowainik/summoner/issues/155):
   Bump up to `tomland-0.5.0`.
 * Drop support for GHC-8.6.1 on CI. Support GHC-8.6.2 on CI.
+* [#202](https://github.com/kowainik/summoner/issues/202):
+  Bump up to `relude-0.4.0`.
+* Add more documentation to the functions.
 
 1.1.0.1
 =======

diff --git a/src/Prelude.hs b/src/Prelude.hs
@@ -10,6 +10,7 @@ module Prelude
 
 import Relude
 import Relude.Extra.Enum as Relude.Extra (inverseMap, universe)
+import Relude.Extra.Validation as Relude.Extra
 
 endLine :: Text
 endLine = "\n"

diff --git a/src/Summoner.hs b/src/Summoner.hs
@@ -10,7 +10,6 @@ module Summoner
        , module Summoner.Settings
        , module Summoner.Template
        , module Summoner.Text
-       , module Summoner.Validation
        ) where
 
 import Summoner.Ansi
@@ -24,4 +23,3 @@ import Summoner.Question
 import Summoner.Settings
 import Summoner.Template
 import Summoner.Text
-import Summoner.Validation
diff --git a/src/Summoner/Ansi.hs b/src/Summoner/Ansi.hs
@@ -26,11 +26,8 @@ import System.Console.ANSI (Color (..), ColorIntensity (Vivid), ConsoleIntensity
                             ConsoleLayer (Foreground), SGR (..), setSGR, setSGRCode)
 import System.IO (hFlush)
 
-----------------------------------------------------------------------------
--- Ansi-terminal
-----------------------------------------------------------------------------
 
--- Explicit flush ensures prompt messages are in the correct order on all systems.
+-- | Explicit flush ensures prompt messages are in the correct order on all systems.
 putStrFlush :: Text -> IO ()
 putStrFlush msg = do
     putText msg
@@ -86,7 +83,7 @@ infoMessage    = colorMessage Blue
 skipMessage    = colorMessage Cyan
 
 blueCode, boldCode, redCode, resetCode :: String
-redCode = setSGRCode [SetColor Foreground Vivid Red]
-blueCode = setSGRCode [SetColor Foreground Vivid Blue]
-boldCode = setSGRCode [SetConsoleIntensity BoldIntensity]
+redCode   = setSGRCode [SetColor Foreground Vivid Red]
+blueCode  = setSGRCode [SetColor Foreground Vivid Blue]
+boldCode  = setSGRCode [SetConsoleIntensity BoldIntensity]
 resetCode = setSGRCode [Reset]
diff --git a/src/Summoner/CLI.hs b/src/Summoner/CLI.hs
@@ -29,23 +29,34 @@ import Summoner.License (License (..), LicenseName (..), fetchLicense, licenseSh
                          parseLicenseName)
 import Summoner.Project (generateProject)
 import Summoner.Settings (CustomPrelude (..))
-import Summoner.Validation (Validation (..))
 
 import qualified Data.Text as T
 
----------------------------------------------------------------------------
--- CLI
-----------------------------------------------------------------------------
 
+-- | Main function that parses @CLI@ commands and runs them.
 summon :: IO ()
 summon = execParser prsr >>= runCommand
 
--- | Run 'summoner' with cli command
+-- | Run 'summoner' with @CLI@ command
 runCommand :: Command -> IO ()
 runCommand = \case
     New opts -> runNew opts
     ShowInfo opts -> runShow opts
 
+{- | Runs @show@ command.
+
+@
+Usage:
+  summon show COMMAND
+      Show supported licenses or ghc versions
+
+Available commands:
+  ghc                      Show available ghc versions
+  license                  Show available licenses
+  license [LICENSE_NAME]   Show specific license text
+@
+
+-}
 runShow :: ShowOpts -> IO ()
 runShow = \case
         -- show list of all available GHC versions
@@ -70,6 +81,18 @@ runShow = \case
     showDesc :: LicenseName -> Text
     showDesc l = show l <> ": " <> licenseShortDesc l
 
+{- | Runs @new@ command.
+
+@
+Usage:
+  summon new PROJECT_NAME [--cabal] [--stack] [--ignore-config]
+             [with [OPTIONS]] [without [OPTIONS]]
+             [-f|--file FILENAME]
+             [--prelude-package PACKAGE_NAME]
+             [--prelude-module MODULE_NAME]
+@
+
+-}
 runNew :: NewOpts -> IO ()
 runNew NewOpts{..} = do
     -- read config from file
@@ -91,6 +114,8 @@ runNew NewOpts{..} = do
     -- print result
     beautyPrint [bold, setColor Green] "\nJob's done\n"
 
+-- | Reads and parses the given config file. If no file is provided the default
+-- configuration returned.
 readFileConfig :: Bool -> Maybe FilePath -> IO PartialConfig
 readFileConfig ignoreFile maybeFile = if ignoreFile then pure mempty else do
     (isDefault, file) <- case maybeFile of

diff --git a/src/Summoner/Config.hs b/src/Summoner/Config.hs
@@ -33,10 +33,11 @@ import Summoner.GhcVer (GhcVer (..), parseGhcVer, showGhcVer)
 import Summoner.License (LicenseName (..), parseLicenseName)
 import Summoner.Settings (CustomPrelude (..), customPreludeT)
 import Summoner.Source (Source, sourceT)
-import Summoner.Validation (Validation (..))
 
 import qualified Toml
 
+
+-- | The phase of the configurations.
 data Phase = Partial | Final
 
 -- | Potentially incomplete configuration.

diff --git a/src/Summoner/GhcVer.hs b/src/Summoner/GhcVer.hs
@@ -68,9 +68,19 @@ baseVerPvp = \case
     Ghc843  -> Pvp 4 11 1 0
     Ghc844  -> Pvp 4 11 1 0
 
+-- | Returns corresponding @base@ version of the given GHC version.
 baseVer :: GhcVer -> Text
 baseVer = show . baseVerPvp
 
+{- | Returns the @base@ bounds for the list of the given GHC versions.
+
+>>> cabalBaseVersions [Ghc844]
+"^>= 4.11.1.0"
+
+>>> cabalBaseVersions [Ghc802, Ghc822, Ghc844]
+">= 4.9.0.0 && < 4.12"
+
+-}
 cabalBaseVersions :: [GhcVer] -> Text
 cabalBaseVersions []   = ""
 cabalBaseVersions [v]  = "^>= " <> baseVer v

diff --git a/src/Summoner/License.hs b/src/Summoner/License.hs
@@ -16,10 +16,8 @@ import System.Process (readProcess)
 import qualified Data.Text as T
 import qualified Text.Show as TS
 
-----------------------------------------------------------------------------
--- License
-----------------------------------------------------------------------------
 
+-- | Licenses supported by @summoner@.
 data LicenseName
     = MIT
     | BSD2
@@ -53,11 +51,12 @@ newtype License = License { unLicense :: Text }
 instance FromJSON License where
     parseJSON = withObject "License" $ \o -> License <$> o .: "body"
 
--- | As it will be shown in @cabal@ file.
+-- | As it will be shown in the @cabal@ file.
 cabalLicense :: LicenseName -> Text
 cabalLicense None = "AllRightsReserved"
 cabalLicense l    = show l
 
+-- | Used for downloading the license text form @Github@.
 githubLicenseQueryNames :: LicenseName -> Text
 githubLicenseQueryNames = \case
     MIT      -> "mit"
@@ -75,6 +74,7 @@ githubLicenseQueryNames = \case
 parseLicenseName :: Text -> Maybe LicenseName
 parseLicenseName = inverseMap show
 
+-- | Replaces name/year placeholders with the actual data.
 customizeLicense :: LicenseName -> License -> Text -> Text -> License
 customizeLicense l license@(License licenseText) nm year
     | l `elem` [MIT, BSD2, BSD3] = License updateLicenseText

diff --git a/src/Summoner/Process.hs b/src/Summoner/Process.hs
@@ -14,18 +14,15 @@ import System.Process (callCommand, showCommandForUser)
 
 import Summoner.Ansi (errorMessage)
 
-----------------------------------------------------------------------------
--- Commands
-----------------------------------------------------------------------------
 
--- This is needed to be able to call commands by writing strings.
+-- | This is needed to be able to call commands by writing strings.
 instance (a ~ Text, b ~ ()) => IsString ([a] -> IO b) where
     fromString cmd args = do
         let cmdStr = showCommandForUser cmd (map toString args)
         putStrLn $ "⚙  " ++ cmdStr
         callCommand cmdStr
 
--- Delete file, but just print a message if delete fails and continue instead of raising an error.
+-- | Delete file, but just print a message if delete fails and continue instead of raising an error.
 deleteFile :: FilePath -> IO  ()
 deleteFile file = removeFile file `catch` printError
   where

diff --git a/src/Summoner/Project.hs b/src/Summoner/Project.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 
--- | This module introduces functional for project creation.
+-- | This module introduces functions for the project creation.
 
 module Summoner.Project
        ( generateProject
@@ -18,16 +18,21 @@ import Summoner.License (LicenseName, customizeLicense, fetchLicense, licenseSho
                          parseLicenseName)
 import Summoner.Process ()
 import Summoner.Question (YesNoPrompt (..), checkUniqueName, choose, chooseYesNo, falseMessage,
-                          mkDefaultYesNoPrompt, query, queryDef,
-                          queryManyRepeatOnFail, targetMessageWithText, trueMessage)
+                          mkDefaultYesNoPrompt, query, queryDef, queryManyRepeatOnFail,
+                          targetMessageWithText, trueMessage)
 import Summoner.Settings (CustomPrelude (..), Settings (..))
 import Summoner.Source (fetchSource)
 import Summoner.Template (createProjectTemplate)
 import Summoner.Text (intercalateMap, packageToModule)
 import Summoner.Tree (showTree, traverseTree)
 
+
 -- | Generate the project.
-generateProject :: Bool -> Text -> Config -> IO ()
+generateProject
+    :: Bool    -- ^ @noUpload@ option (to not upload to @Github@).
+    -> Text    -- ^ Given project name.
+    -> Config  -- ^ Given configurations.
+    -> IO ()
 generateProject noUpload projectName Config{..} = do
     settingsRepo   <- checkUniqueName projectName
     -- decide cabal stack or both
@@ -53,19 +58,22 @@ generateProject noUpload projectName Config{..} = do
             settingsFullName
             settingsYear
 
-    -- Library/Executable/Tests/Benchmarks flags
-    settingsGitHub   <- decisionToBool cGitHub (YesNoPrompt "GitHub integration" "Do you want to create a GitHub repository?")
-    settingsPrivat   <- ifGithub (settingsGitHub && not noUpload) (YesNoPrompt "private repository" "Create as a private repository (Requires a GitHub private repo plan)?") cPrivate
-    settingsTravis   <- ifGithub settingsGitHub (mkDefaultYesNoPrompt "Travis CI integration") cTravis
-    settingsAppVeyor <- ifGithub (settingsStack && settingsGitHub) (mkDefaultYesNoPrompt "AppVeyor CI integration") cAppVey
+    settingsGitHub   <- decisionToBool cGitHub
+        (YesNoPrompt "GitHub integration" "Do you want to create a GitHub repository?")
+    settingsPrivat   <- decisionIf
+        (settingsGitHub && not noUpload)
+        (YesNoPrompt "private repository" "Create as a private repository (Requires a GitHub private repo plan)?")
+        cPrivate
+    settingsTravis   <- decisionIf settingsGitHub (mkDefaultYesNoPrompt "Travis CI integration") cTravis
+    settingsAppVeyor <- decisionIf (settingsStack && settingsGitHub) (mkDefaultYesNoPrompt "AppVeyor CI integration") cAppVey
     settingsIsLib    <- decisionToBool cLib (mkDefaultYesNoPrompt "library target")
     settingsIsExe    <- let target = "executable target" in
-              if settingsIsLib
-              then decisionToBool cExe (mkDefaultYesNoPrompt target)
-              else trueMessage target
-    settingsTest   <- decisionToBool cTest (mkDefaultYesNoPrompt "tests")
-    settingsBench  <- decisionToBool cBench (mkDefaultYesNoPrompt "benchmarks")
-    settingsPrelude <- if settingsIsLib then getPrelude else pure Nothing
+        if settingsIsLib
+        then decisionToBool cExe (mkDefaultYesNoPrompt target)
+        else trueMessage target
+    settingsTest     <- decisionToBool cTest (mkDefaultYesNoPrompt "tests")
+    settingsBench    <- decisionToBool cBench (mkDefaultYesNoPrompt "benchmarks")
+    settingsPrelude  <- if settingsIsLib then getPrelude else pure Nothing
     let settingsBaseType = case settingsPrelude of
             Nothing -> "base"
             Just _  -> "base-noprelude"
@@ -95,8 +103,8 @@ generateProject noUpload projectName Config{..} = do
     when settingsGitHub $ doGithubCommands settings settingsPrivat
 
  where
-    ifGithub :: Bool -> YesNoPrompt -> Decision -> IO Bool
-    ifGithub github ynPrompt decision = if github
+    decisionIf :: Bool -> YesNoPrompt -> Decision -> IO Bool
+    decisionIf p ynPrompt decision = if p
         then decisionToBool decision ynPrompt
         else falseMessage (yesNoTarget ynPrompt)