packages feed

templatise 0.1.6.0 → 0.1.7.0

raw patch · 16 files changed

+288/−295 lines, 16 filesdep −MissingHdep ~Cabal-syntaxPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: MissingH

Dependency ranges changed: Cabal-syntax

API changes (from Hackage documentation)

- Configuration: Configuration :: Text -> Text -> URI -> Text -> Text -> LicenseId -> FilePath -> Year -> LogLevel -> Configuration
- Configuration: [author] :: Configuration -> Text
- Configuration: [cabalName] :: Configuration -> Text
- Configuration: [homepage] :: Configuration -> URI
- Configuration: [licence] :: Configuration -> LicenseId
- Configuration: [maintainer] :: Configuration -> Text
- Configuration: [name] :: Configuration -> Text
- Configuration: [path] :: Configuration -> FilePath
- Configuration: [verbosity] :: Configuration -> LogLevel
- Configuration: [year] :: Configuration -> Year
- Configuration: data Configuration
- Configuration: parser :: Defaults -> Parser Configuration
+ Cabal: instance GHC.Exception.Type.Exception Cabal.MissingAnnotationException
+ Cabal: instance GHC.Show.Show Cabal.MissingAnnotationException
+ Environment: T :: Text -> Text -> URI -> Text -> Text -> LicenseId -> FilePath -> Year -> LogLevel -> T
+ Environment: [author] :: T -> Text
+ Environment: [cabalName] :: T -> Text
+ Environment: [homepage] :: T -> URI
+ Environment: [licence] :: T -> LicenseId
+ Environment: [maintainer] :: T -> Text
+ Environment: [name] :: T -> Text
+ Environment: [path] :: T -> FilePath
+ Environment: [verbosity] :: T -> LogLevel
+ Environment: [year] :: T -> Year
+ Environment: data T
+ Environment: instance GHC.Show.Show Environment.T
+ Options: parserInfo :: Defaults -> ParserInfo T
- Initialiser: runInitialiser :: Initialiser a -> Configuration -> IO a
+ Initialiser: runInitialiser :: Initialiser a -> T -> IO a

Files

CHANGELOG.md view
@@ -2,6 +2,12 @@  ## unreleased +### 0.1.7.0 -- 2024-09-28++### Added++- Support for Cabal-syntax-3.14.0.0+ ## 0.1.6.0 -- 2024-08-18  ### Added
bin/initialise/Main.hs view
@@ -1,24 +1,9 @@ module Main (main) where -import qualified Configuration (parser) import qualified Defaults (getDefaults) import Initialiser (defaultInitialiser, runInitialiser)-import Options.Applicative (execParser, fullDesc, helper, info, progDesc, (<**>))+import qualified Options (parserInfo)+import Options.Applicative (execParser)  main :: IO ()-main = do-  defaults <- Defaults.getDefaults--  let options =-        info-          (Configuration.parser defaults <**> helper)-          ( fullDesc-              <> progDesc-                ( unlines-                    [ "Initialise a new project using the current checked out repository.",-                      "WARNING: THIS WILL MODIFY THE CURRENT CONTENTS OF YOUR CHECKED OUT REPOSITORY!"-                    ]-                )-          )--  execParser options >>= runInitialiser defaultInitialiser+main = Defaults.getDefaults >>= execParser . Options.parserInfo >>= runInitialiser defaultInitialiser
lib/initialise/Cabal.hs view
@@ -7,12 +7,12 @@  module Cabal (replace, convert) where -import Configuration (Configuration (..))-import Control.Monad.Catch (throwM)+import Control.Monad.Catch (Exception, throwM) import Control.Monad.Logger (logInfo) import Control.Monad.Reader (MonadReader (ask), asks, liftIO) import Data.ByteString (ByteString, append, breakSubstring, concat, readFile, stripPrefix)-import qualified Data.ByteString.Char8 as BS (pack)+import qualified Data.ByteString.Char8 as BS (pack, unpack)+import Data.List.NonEmpty (head, nonEmpty) import Data.Text (Text, unlines) import qualified Data.Text as T (pack, unpack) import Data.Text.Encoding (encodeUtf8)@@ -30,17 +30,22 @@ import Distribution.Fields.Field (fieldLineAnn) import Distribution.Parsec.Position (Position) import Distribution.SPDX (licenseId)+import qualified Environment (T (..)) import Initialiser.Types (Initialiser) import System.Directory.Extra (createDirectoryIfMissing, removeDirectoryRecursive, removeFile) import System.FilePath (replaceBaseName, (</>))-import Prelude hiding (concat, readFile, unlines, writeFile)+import Prelude hiding (concat, head, readFile, unlines, writeFile)  #if __GLASGOW_HASKELL__ < 908-import Control.Exception (Exception) import Text.Parsec.Error (ParseError) instance Exception ParseError #endif +newtype MissingAnnotationException = MissingAnnotationException Text+  deriving (Show)++instance Exception MissingAnnotationException+ replace :: FilePath -> Initialiser () replace path = do   replaceCabal path@@ -51,7 +56,7 @@ replaceCabal :: FilePath -> Initialiser () replaceCabal path = do   -- TODO handle in replaceWith-  path' <- asks (replaceBaseName path . T.unpack . name)+  path' <- asks (replaceBaseName path . T.unpack . Environment.name)   $logInfo ("replacing cabal " <> T.pack (show path) <> " with " <> T.pack (show path'))   -- TODO replaceWith convert   contents <- liftIO $ readFile path@@ -67,7 +72,11 @@  convert' :: Field Position -> Initialiser (Field Position) convert' f@(Field n@(Name _ fName) ls) = do-  Configuration {..} <- asks id+  Environment.T {..} <- asks id+  annotation <- case nonEmpty ls of+    (Just ls') -> pure $ fieldLineAnn (head ls')+    Nothing -> throwM $ MissingAnnotationException $ "field " <> T.pack (BS.unpack fName) <> " has no annotation"+  let field s = pure $ Field n [FieldLine annotation s]   case fName of     -- package     "name" -> field (encodeUtf8 cabalName)@@ -89,11 +98,8 @@     -- source-repository     "location" -> field $ BS.pack $ show homepage     _ -> pure f-  where-    field s = pure $ Field n [FieldLine annotation s]-    annotation = fieldLineAnn . head $ ls convert' (Section n arguments fs) = do-  Configuration {..} <- asks id+  Environment.T {..} <- asks id   fs' <- mapM convert' fs   pure $ Section n (map (convertSectionArgument name) arguments) fs' @@ -117,7 +123,7 @@ -- TODO Move to Initialise module? replaceDirectoryWith :: FilePath -> (FilePath -> Initialiser ()) -> Initialiser () replaceDirectoryWith component r = do-  Configuration {..} <- ask+  Environment.T {..} <- ask   let new = component </> T.unpack name   let original = component </> "initialise"   $logInfo ("replacing directory " <> T.pack (show original) <> " with " <> T.pack (show new))@@ -130,7 +136,7 @@  replaceTest :: FilePath -> Initialiser () replaceTest path = do-  name' <- asks name+  name' <- asks Environment.name   -- TODO Template library.   liftIO $     writeFile (path </> "Main.hs") $@@ -145,7 +151,7 @@  replaceBin :: FilePath -> Initialiser () replaceBin path = do-  name' <- asks name+  name' <- asks Environment.name   -- TODO Template library.(*)   liftIO $     writeFile (path </> "Main.hs") $
− lib/initialise/Configuration.hs
@@ -1,133 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Configuration-  ( Configuration (..),-    parser,-  )-where--import Control.Monad.Logger (LogLevel)-import Control.Monad.Logger.CallStack (LogLevel (LevelWarn))-import Data.Text (Text)-import Data.Time.Calendar (Year)-import Defaults (Defaults (..), dCabalName, dHomePage, dName)-import Distribution.SPDX.LicenseId (LicenseId (Unlicense))-import Network.URI (URI, parseURI)-import Options.Applicative-  ( Parser,-    auto,-    help,-    hidden,-    internal,-    long,-    metavar,-    option,-    showDefault,-    strOption,-    value,-  )-import Options.Applicative.Builder (maybeReader)--data Configuration = Configuration-  { name :: Text,-    cabalName :: Text,-    homepage :: URI,-    author :: Text,-    maintainer :: Text,-    licence :: LicenseId,-    path :: FilePath,-    year :: Year,-    verbosity :: LogLevel-  }--parser :: Defaults -> Parser Configuration-parser ds@(Defaults {..}) = do-  name <--    strOption-      ( long "name"-          <> help "Name of the new project."-          <> metavar-            "NAME"-          <> maybeDefault (dName ds)-      )-  cabalName <--    strOption-      ( long "cabal-name"-          <> help "Name to use in cabal."-          <> metavar "CABAL_NAME"-          <> maybeDefault (dCabalName ds)-      )-  homepage <--    option-      (maybeReader parseURI)-      ( long "homepage"-          <> help-            "Homepage of the new project."-          <> metavar "URL"-          <> maybeDefault (dHomePage ds)-      )-  author <--    strOption-      ( long "author"-          <> help "Name of the author of the project."-          <> metavar "AUTHOR"-          <> value dAuthor-          <> showDefault-      )-  maintainer <--    strOption-      ( long "maintainer"-          <> help-            "Email of the maintainer of the project."-          <> metavar "MAINTAINER"-          <> value dMaintainer-          <> showDefault-      )-  licence <--    option-      auto-      ( long "licence"-          <> help "Licence of the project."-          <> value Unlicense-          <> showDefault-          <> metavar "LICENCE"-      )-  path <--    option-      auto-      ( long "path"-          <> help "Project path.  Only used for testing."-          <> value dPath-          <> showDefault-          <> metavar "PATH"-          <> hidden-          <> internal-      )-  year <--    option-      auto-      ( long "year"-          <> help "Copyright year.  Only used for testing."-          <> value dYear-          <> showDefault-          <> metavar "YEAR"-          <> hidden-          <> internal-      )-  verbosity <--    option-      auto-      ( long "verbosity"-          <> help-            "Verbosity of information printed to stderr."-          <> value LevelWarn-          <> showDefault-          <> metavar "VERBOSITY"-      )-  pure Configuration {..}-  where-    -- maybeDefault :: (HasValue f, Show a) => Maybe a -> Mod f a-    maybeDefault (Just a) = value a <> showDefault-    maybeDefault Nothing = mempty
+ lib/initialise/Environment.hs view
@@ -0,0 +1,20 @@+module Environment (T (..)) where++import Control.Monad.Logger (LogLevel)+import Data.Text (Text)+import Data.Time.Calendar (Year)+import Distribution.SPDX.LicenseId (LicenseId)+import Network.URI (URI)++data T = T+  { name :: Text,+    cabalName :: Text,+    homepage :: URI,+    author :: Text,+    maintainer :: Text,+    licence :: LicenseId,+    path :: FilePath,+    year :: Year,+    verbosity :: LogLevel+  }+  deriving (Show)
lib/initialise/File.hs view
@@ -8,12 +8,12 @@   ) where -import Configuration (Configuration (..)) import Control.Monad.Logger (logInfo) import Control.Monad.Reader (MonadIO (liftIO), MonadReader (ask)) import Data.Text (Text, pack) import qualified Data.Text as T (replace) import Data.Text.IO (readFile, writeFile)+import qualified Environment (T (..)) import Initialiser.Types (Initialiser) import Prelude hiding (readFile, writeFile) @@ -27,7 +27,7 @@  convert :: Text -> Initialiser Text convert contents = do-  Configuration {..} <- ask+  Environment.T {..} <- ask   pure     . T.replace "templatise" name     . T.replace "template-hs" name
lib/initialise/Initialiser/Types.hs view
@@ -6,16 +6,16 @@   ) where -import Configuration (Configuration) import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (LoggingT, MonadLogger, runStderrLoggingT) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)+import qualified Environment (T)  newtype Initialiser a = Initialiser-  { run :: LoggingT (ReaderT Configuration IO) a+  { run :: LoggingT (ReaderT Environment.T IO) a   }-  deriving (Applicative, Functor, Monad, MonadIO, MonadLogger, MonadReader Configuration, MonadThrow)+  deriving (Applicative, Functor, Monad, MonadIO, MonadLogger, MonadReader Environment.T, MonadThrow) -runInitialiser :: Initialiser a -> Configuration -> IO a+runInitialiser :: Initialiser a -> Environment.T -> IO a runInitialiser initialiser = runReaderT (runStderrLoggingT $ run initialiser)
lib/initialise/Licence.hs view
@@ -7,13 +7,13 @@   ) where -import Configuration (Configuration (..)) import Control.Monad (unless) import Control.Monad.Logger (logInfo) import Control.Monad.Reader (ask, liftIO) import Data.ByteString.Lazy (ByteString, writeFile) import Data.Text (pack) import Distribution.SPDX.LicenseId (LicenseId (Unlicense), licenseId)+import qualified Environment (T (..)) import Initialiser.Types (Initialiser) import Network.HTTP.Client (responseBody) import Network.HTTP.Simple (httpLBS, parseRequest)@@ -22,7 +22,7 @@  replace :: FilePath -> Initialiser () replace p = do-  Configuration {..} <- ask+  Environment.T {..} <- ask   unless (licence == Unlicense) $ do     $logInfo ("replacing LICENSE " <> pack (show p))     liftIO (writeFile (path </> p) =<< contents licence)
+ lib/initialise/Options.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Options (parserInfo) where++import Control.Monad.Logger.CallStack (LogLevel (LevelWarn))+import Defaults (Defaults (..), dCabalName, dHomePage, dName)+import Distribution.SPDX.LicenseId (LicenseId (Unlicense))+import qualified Environment (T (..))+import Network.URI (parseURI)+import Options.Applicative+  ( HasValue,+    Mod,+    Parser,+    ParserInfo,+    auto,+    fullDesc,+    help,+    helper,+    hidden,+    info,+    internal,+    long,+    metavar,+    option,+    progDesc,+    showDefault,+    strOption,+    value,+    (<**>),+  )+import Options.Applicative.Builder (maybeReader)++parserInfo :: Defaults -> ParserInfo Environment.T+parserInfo ds =+  info+    (parser ds <**> helper)+    ( fullDesc+        <> progDesc+          ( unlines+              [ "Initialise a new project using the current checked out repository.",+                "WARNING: THIS WILL MODIFY THE CURRENT CONTENTS OF YOUR CHECKED OUT REPOSITORY!"+              ]+          )+    )++parser :: Defaults -> Parser Environment.T+parser ds@(Defaults {..}) = do+  name <-+    strOption+      ( long "name"+          <> help "Name of the new project."+          <> metavar+            "NAME"+          <> maybeDefault (dName ds)+      )+  cabalName <-+    strOption+      ( long "cabal-name"+          <> help "Name to use in cabal."+          <> metavar "CABAL_NAME"+          <> maybeDefault (dCabalName ds)+      )+  homepage <-+    option+      (maybeReader parseURI)+      ( long "homepage"+          <> help+            "Homepage of the new project."+          <> metavar "URL"+          <> maybeDefault (dHomePage ds)+      )+  author <-+    strOption+      ( long "author"+          <> help "Name of the author of the project."+          <> metavar "AUTHOR"+          <> value dAuthor+          <> showDefault+      )+  maintainer <-+    strOption+      ( long "maintainer"+          <> help+            "Email of the maintainer of the project."+          <> metavar "MAINTAINER"+          <> value dMaintainer+          <> showDefault+      )+  licence <-+    option+      auto+      ( long "licence"+          <> help "Licence of the project."+          <> value Unlicense+          <> showDefault+          <> metavar "LICENCE"+      )+  path <-+    option+      auto+      ( long "path"+          <> help "Project path.  Only used for testing."+          <> value dPath+          <> showDefault+          <> metavar "PATH"+          <> hidden+          <> internal+      )+  year <-+    option+      auto+      ( long "year"+          <> help "Copyright year.  Only used for testing."+          <> value dYear+          <> showDefault+          <> metavar "YEAR"+          <> hidden+          <> internal+      )+  verbosity <-+    option+      auto+      ( long "verbosity"+          <> help+            "Verbosity of information printed to stderr."+          <> value LevelWarn+          <> showDefault+          <> metavar "VERBOSITY"+      )+  pure Environment.T {..}++maybeDefault :: (HasValue f, Show a) => Maybe a -> Mod f a+maybeDefault (Just a) = value a <> showDefault+maybeDefault Nothing = mempty
templatise.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               templatise-version:            0.1.6.0+version:            0.1.7.0 license:            Unlicense license-file:       LICENSE copyright:          (c) 2023 Alex Brandt@@ -37,9 +37,9 @@  common initialise-common   build-depends:-    , base                  ^>=4.16.3.0 || ^>=4.17     || ^>=4.18     || ^>=4.19 || ^>=4.20+    , base                  ^>=4.16.3.0 || ^>=4.17     || ^>=4.18     || ^>=4.19     || ^>=4.20     , bytestring            ^>=0.11.3.1 || ^>=0.12.0.2-    , Cabal-syntax          ^>=3.8.1.0  || ^>=3.10.1.0 || ^>=3.12.0.0+    , Cabal-syntax          ^>=3.8.1.0  || ^>=3.10.1.0 || ^>=3.12.0.0 || ^>=3.14.0.0     , filepath              >=1.4.2.2   && <1.6     , monad-logger          ^>=0.3.40     , mtl                   ^>=2.2.2    || ^>=2.3.1@@ -58,12 +58,13 @@   import:           initialise-common   exposed-modules:     Cabal-    Configuration     Defaults+    Environment     File     Git     Initialiser     Licence+    Options    -- TODO Make Git private.   other-modules:@@ -97,7 +98,6 @@     , directory           ^>=1.3.6.2     , hspec               ^>=2.11.4     , initialise-library-    , MissingH            ^>=1.6.0.1     , tasty               ^>=1.4.3   || ^>=1.5     , tasty-golden        ^>=2.3.5     , tasty-hspec         ^>=1.2.0.4@@ -105,12 +105,12 @@    other-modules:     CabalGolden-    ConfigurationSpec     DefaultsSpec     FileGolden     GitSpec     Hooks     InitialiseSpec+    OptionsSpec    hs-source-dirs:   test/initialise 
test/initialise/CabalGolden.hs view
@@ -3,7 +3,6 @@ module CabalGolden (golden) where  import qualified Cabal as SUT-import Configuration (Configuration (..)) import Control.Monad.Logger (LogLevel (LevelDebug)) import Control.Monad.Reader (liftIO) import Data.ByteString (readFile)@@ -11,6 +10,7 @@ import Data.Maybe (fromJust) import Data.Text (unpack) import Distribution.SPDX.LicenseId (LicenseId (MIT))+import qualified Environment (T (..)) import Initialiser (runInitialiser) import Network.URI (parseURI) import System.FilePath (isExtensionOf, normalise, replaceExtension, takeBaseName)@@ -35,16 +35,16 @@     gold = p `replaceExtension` ".golden.cabal"     action = do       contents <- liftIO (readFile p)-      pack . unpack <$> runInitialiser (SUT.convert contents) configuration-    configuration =-      Configuration-        { name = "sentinel",-          cabalName = "sentinel",-          homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),-          author = "Sentinel",-          maintainer = "sentinel@example.com",-          licence = MIT,-          path = ".",-          year = 1970,-          verbosity = LevelDebug+      pack . unpack <$> runInitialiser (SUT.convert contents) environment+    environment =+      Environment.T+        { Environment.name = "sentinel",+          Environment.cabalName = "sentinel",+          Environment.homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),+          Environment.author = "Sentinel",+          Environment.maintainer = "sentinel@example.com",+          Environment.licence = MIT,+          Environment.path = ".",+          Environment.year = 1970,+          Environment.verbosity = LevelDebug         }
− test/initialise/ConfigurationSpec.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module ConfigurationSpec (spec) where--import qualified Configuration as SUT-import Data.String.Utils (strip)-import Defaults (Defaults (..))-import Options.Applicative-  ( ParserResult-      ( CompletionInvoked,-        Failure,-        Success-      ),-    defaultPrefs,-    execParserPure,-    helper,-    info,-    renderFailure,-    (<**>),-  )-import System.Exit (ExitCode (ExitFailure))-import Test.Hspec (Expectation, Spec, describe, expectationFailure, it, shouldBe)--spec :: Spec-spec =-  describe "Configuration" $ do-    describe "parser" $ do-      it "should error if homepage isn't a URI" $-        parse ["--homepage", "not-a-url"]-          `shouldFailWith` ( strip $-                               unlines-                                 ( [ "option --homepage: cannot parse value `not-a-url'",-                                     ""-                                   ]-                                     <> usage-                                 ),-                             ExitFailure 1-                           )-      it "should error if licence isn't an SPDX licence ID" $ do-        parse ["--licence", "not-a-licence"]-          `shouldFailWith` ( strip $-                               unlines-                                 ( [ "option --licence: cannot parse value `not-a-licence'",-                                     ""-                                   ]-                                     <> usage-                                 ),-                             ExitFailure 1-                           )--parse :: [String] -> ParserResult SUT.Configuration-parse =-  execParserPure-    defaultPrefs-    ( info (SUT.parser defaults <**> helper) mempty-    )--shouldFailWith :: ParserResult SUT.Configuration -> (String, ExitCode) -> Expectation-shouldFailWith (Success _) _ = expectationFailure "Expected Failure but got Success"-shouldFailWith (CompletionInvoked _) _ = expectationFailure "Expected Failure but got CompletionInvoked"-shouldFailWith (Failure f) rhs = renderFailure f "" `shouldBe` rhs--defaults :: Defaults-defaults =-  Defaults-    { dOrigin = "http://github.com/username/repository.git",-      dAuthor = "Forename Surname",-      dMaintainer = "username@example.com",-      dPath = ".",-      dYear = 1970-    }---- TODO ask the parser for the usage string.-usage :: [String]-usage =-  [ "Usage:  [--name NAME] [--cabal-name CABAL_NAME] [--homepage URL] ",-    "        [--author AUTHOR] [--maintainer MAINTAINER] [--licence LICENCE] ",-    "        [--verbosity VERBOSITY]"-  ]
test/initialise/FileGolden.hs view
@@ -2,7 +2,6 @@  module FileGolden (golden) where -import Configuration (Configuration (..)) import Control.Monad.Logger (LogLevel (LevelDebug)) import Control.Monad.Reader (liftIO) import Data.Maybe (fromJust)@@ -10,6 +9,7 @@ import Data.Text.Lazy (fromStrict) import Data.Text.Lazy.Encoding (encodeUtf8) import Distribution.SPDX.LicenseId (LicenseId (MIT))+import qualified Environment (T (..)) import qualified File as SUT import Initialiser (runInitialiser) import Network.URI (parseURI)@@ -46,14 +46,14 @@       contents <- liftIO (readFile p)       encodeUtf8 . fromStrict <$> runInitialiser (SUT.convert contents) configuration     configuration =-      Configuration-        { name = "sentinel",-          cabalName = "sentinel",-          homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),-          author = "Sentinel",-          maintainer = "sentinel@example.com",-          licence = MIT,-          path = ".",-          year = 1970,-          verbosity = LevelDebug+      Environment.T+        { Environment.name = "sentinel",+          Environment.cabalName = "sentinel",+          Environment.homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),+          Environment.author = "Sentinel",+          Environment.maintainer = "sentinel@example.com",+          Environment.licence = MIT,+          Environment.path = ".",+          Environment.year = 1970,+          Environment.verbosity = LevelDebug         }
test/initialise/InitialiseSpec.hs view
@@ -2,11 +2,11 @@  module InitialiseSpec (spec) where -import Configuration (Configuration (..)) import Control.Monad.Logger (LogLevel (LevelDebug)) import Data.Maybe (fromJust) import Data.Text (Text, pack) import Distribution.SPDX (LicenseId (MIT))+import qualified Environment (T (..)) import Hooks (withProjectCopy) import qualified Initialiser as SUT import Network.URI (parseURI)@@ -20,16 +20,16 @@   describe "defaultInitialiser" $ do     runIO $ withProjectCopy $ \p -> do       let configuration =-            Configuration-              { name = "sentinel",-                cabalName = "sentinel",-                homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),-                author = "Sentinel",-                maintainer = "sentinel@example.com",-                licence = MIT,-                path = p,-                year = 1970,-                verbosity = LevelDebug+            Environment.T+              { Environment.name = "sentinel",+                Environment.cabalName = "sentinel",+                Environment.homepage = fromJust (parseURI "https://github.com/sentinel/sentinel.git"),+                Environment.author = "Sentinel",+                Environment.maintainer = "sentinel@example.com",+                Environment.licence = MIT,+                Environment.path = p,+                Environment.year = 1970,+                Environment.verbosity = LevelDebug               }        SUT.runInitialiser SUT.defaultInitialiser configuration
test/initialise/Main.hs view
@@ -1,11 +1,11 @@ module Main (main) where  import qualified CabalGolden (golden)-import qualified ConfigurationSpec (spec) import qualified DefaultsSpec (spec) import qualified FileGolden (golden) import qualified GitSpec (spec) import qualified InitialiseSpec (spec)+import qualified OptionsSpec (spec) import Test.Tasty (defaultMain, testGroup) import Test.Tasty.Hspec (testSpecs) @@ -15,7 +15,7 @@     concat       <$> mapM         testSpecs-        [ ConfigurationSpec.spec,+        [ OptionsSpec.spec,           DefaultsSpec.spec,           GitSpec.spec,           InitialiseSpec.spec
+ test/initialise/OptionsSpec.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}++module OptionsSpec (spec) where++import Data.Text (Text, isInfixOf, pack)+import Defaults (Defaults (..))+import qualified Environment (T)+import qualified Options as SUT+import Options.Applicative+  ( ParserResult+      ( CompletionInvoked,+        Failure,+        Success+      ),+    defaultPrefs,+    execParserPure,+    renderFailure,+  )+import System.Exit (ExitCode (ExitFailure, ExitSuccess))+import Test.Hspec (Spec, describe, it, shouldSatisfy)++spec :: Spec+spec =+  describe "Options" $ do+    describe "parserInfo" $ do+      it "should error if homepage isn't a URI" $+        parse ["--homepage", "not-a-url"]+          `shouldSatisfy` failWith "option --homepage: cannot parse value `not-a-url'"+      it "should error if licence isn't an SPDX licence ID" $ do+        parse ["--licence", "not-a-licence"]+          `shouldSatisfy` failWith "option --licence: cannot parse value `not-a-licence'"++failWith :: Text -> ParserResult a -> Bool+failWith _ (Success _) = False+failWith _ (CompletionInvoked _) = False+failWith m (Failure f) = case renderFailure f "" of+  (_, ExitSuccess) -> False+  (m', ExitFailure _) -> m `isInfixOf` pack m'++parse :: [String] -> ParserResult Environment.T+parse =+  execParserPure defaultPrefs (SUT.parserInfo defaults)++defaults :: Defaults+defaults =+  Defaults+    { dOrigin = "http://github.com/username/repository.git",+      dAuthor = "Forename Surname",+      dMaintainer = "username@example.com",+      dPath = ".",+      dYear = 1970+    }