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 +6/−0
- bin/initialise/Main.hs +3/−18
- lib/initialise/Cabal.hs +20/−14
- lib/initialise/Configuration.hs +0/−133
- lib/initialise/Environment.hs +20/−0
- lib/initialise/File.hs +2/−2
- lib/initialise/Initialiser/Types.hs +4/−4
- lib/initialise/Licence.hs +2/−2
- lib/initialise/Options.hs +136/−0
- templatise.cabal +6/−6
- test/initialise/CabalGolden.hs +13/−13
- test/initialise/ConfigurationSpec.hs +0/−79
- test/initialise/FileGolden.hs +11/−11
- test/initialise/InitialiseSpec.hs +11/−11
- test/initialise/Main.hs +2/−2
- test/initialise/OptionsSpec.hs +52/−0
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+ }