Checkpoint testing and preparing for cabal parsing.

lib/initialise/Cabal.hs

@@ -1,9 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 
-module Cabal (convert) where
+module Cabal (replace, convert) where
 
-import Configuration (MetaData (..))
 import Control.Exception (Exception)
 import Control.Monad.Catch (throwM)
 import Data.ByteString (ByteString, readFile)
@@ -46,7 +45,7 @@ import Distribution.Types.UnqualComponentName (mkUnqualComponentName)
 import Distribution.Types.Version (mkVersion)
 import Distribution.Utils.ShortText (toShortText)
 import GHC.Base (NonEmpty)
-import Replace (replaceWith)
+import Initialise (Initialise)
 import System.FilePath ((</>))
 import Text.Parsec.Error (ParseError)
 import Prelude hiding (readFile)
@@ -55,7 +54,16 @@ instance Exception (NonEmpty PError)
 
 instance Exception ParseError
 
-convert :: MetaData -> FilePath -> IO ()
+replace :: FilePath -> Initialise ()
+replace path = do
+  -- TODO handle in replaceWith
+  path' <- replaceBaseName . name <$> ask
+  -- TODO replaceWith convert
+  liftIO (readFile path) >>= convert >>= liftIO (writeFile path')
+  -- TODO handle in replaceWith
+  liftIO $ removeFile path
+
+convert :: Text -> Initialise Text
 convert metadata cabal = (path metadata `replaceWith`) . modifyWith metadata <$> contents cabal
 
 contents :: FilePath -> IO [Field Position]

lib/initialise/Configuration.hs

@@ -2,17 +2,16 @@
 {-# LANGUAGE RecordWildCards #-}
 
 module Configuration
-  ( getDefaults,
-    MetaData (..),
+  ( Configuration (..),
     parser,
   )
 where
 
-import Data.Maybe (maybe)
+import Data.Text (Text)
 import Data.Time.Calendar (Year)
 import Defaults (Defaults (..), dHomePage, dName)
 import Distribution.SPDX.LicenseId (LicenseId (Unlicense))
-import Network.URI (URI (uriPath), parseURI)
+import Network.URI (URI, parseURI)
 import Options.Applicative
   ( Parser,
     auto,
@@ -22,15 +21,13 @@ import Options.Applicative
     long,
     metavar,
     option,
-    short,
     showDefault,
     strOption,
     value,
   )
 import Options.Applicative.Builder (maybeReader)
-import System.FilePath (dropExtension, takeBaseName)
 
-data MetaData = MetaData
+data Configuration = Configuration
   { name :: Text,
     homepage :: URI,
     author :: Text,
@@ -40,9 +37,9 @@ data MetaData = MetaData
     year :: Year
   }
 
-parser :: Defaults -> Parser MetaData
+parser :: Defaults -> Parser Configuration
 parser ds@(Defaults {..}) =
-  MetaData
+  Configuration
     <$> strOption
       ( long "name"
           <> help "Name of the new project."
@@ -84,7 +81,7 @@ parser ds@(Defaults {..}) =
       auto
       ( long "path"
           <> help "Project path.  Only used for testing."
-          <> value path
+          <> value dPath
           <> showDefault
           <> metavar "PATH"
           <> hidden
@@ -94,7 +91,7 @@ parser ds@(Defaults {..}) =
       auto
       ( long "year"
           <> help "Copyright year.  Only used for testing."
-          <> value year
+          <> value dYear
           <> showDefault
           <> metavar "YEAR"
           <> hidden

lib/initialise/Defaults.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE RecordWildCards #-}
 
 module Defaults
-  ( Defaults (..),
-    getDefaults,
+  ( getDefaults,
+    Defaults (..),
     dName,
     dHomePage,
   )

lib/initialise/Initialise.hs

@@ -1,19 +1,13 @@
 module Initialise
   ( Initialise,
     runInitialise,
-    relativePath,
-    replaceIf,
-    replace,
   )
 where
 
+import Configuration (Configuration)
 import Control.Monad.Reader (ReaderT, runReaderT)
-import GHC.IO.Encoding (TextDecoder)
 
-type Initialise = ReaderT MetaData IO
+type Initialise = ReaderT Configuration IO
 
-runInitialise :: Initialise () -> IO ()
+runInitialise :: Initialise () -> Configuration -> IO ()
 runInitialise = runReaderT
-
-contents :: FilePath -> Initialise Text
-contents path = undefined

templatise.cabal

@@ -36,16 +36,24 @@ library initialise-library
   import:           initialise-common
   exposed-modules:
     Cabal
+    Configuration
     Defaults
     Git
+    Initialise
 
   -- TODO Make Git private.
-  --other-modules:
+  --other-modules: Git
   build-depends:
-    , extra     ^>=1.7.14
-    , filepath  ^>=1.4.2.2
-    , process   ^>=1.6.16.0
-    , time      ^>=1.12.2
+    , bytestring            ^>=0.11.4.0 || ^>=0.12.0.2
+    , Cabal-syntax          ^>=3.10.1.0
+    , exceptions            ^>=0.10.7
+    , extra                 ^>=1.7.14
+    , filepath              ^>=1.4.2.2
+    , mtl                   ^>=2.2.2
+    , optparse-applicative  ^>=0.18.1.0
+    , parsec                ^>=3.1.16.1
+    , process               ^>=1.6.16.0
+    , time                  ^>=1.12.2
 
   hs-source-dirs:   lib/initialise
 
@@ -67,7 +75,8 @@ test-suite initialise-test
     , tasty-hspec         ^>=1.2.0.4
 
   other-modules:
-    CabalSpec
+    CabalGolden
+    ConfigurationSpec
     DefaultsSpec
     GitSpec
 
@@ -83,15 +92,10 @@ test-suite initialise-test
 executable initialise
   main-is:          Main.hs
   build-depends:
-    , base                  ^>=4.16.4.0 || ^>=4.17.0.0 || ^>=4.18.0.0
-    , bytestring            ^>=0.11.4.0 || ^>=0.12.0.2
-    , Cabal                 ^>=3.6.3.0  || ^>=3.8.1.0  || ^>=3.10.1.0
-    , exceptions            ^>=0.10.7
-    , http-client           ^>=0.7.13.1
-    , http-conduit          ^>=2.3.8.3
+    , base                ^>=4.16.4.0 || ^>=4.17.0.0 || ^>=4.18.0.0
+    , http-client         ^>=0.7.13.1
+    , http-conduit        ^>=2.3.8.3
     , initialise-library
-    , optparse-applicative  ^>=0.18.1.0
-    , parsec                ^>=3.1.16.1
 
   --other-modules:
   --  Cabal

test/initialise/CabalGolden.hs

@@ -0,0 +1,23 @@
+module CabalGolden (golden) where
+
+import Data.Maybe (fromJust)
+import qualified Defaults as SUT
+import Network.URI (parseURI)
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Tasty (TestTree)
+import Test.Tasty.Golden (TestTree)
+
+golden :: IO TestTree
+golden =
+  testGroup "Cabal" $
+    testGroup "convert" . map convertTest <$> findByExtension [".cabal"] d
+  where
+    d = normalise "test/initialise/data"
+
+convertTest :: FilePath -> TestTree
+convertTest path = goldenVsStringDiff name diff golden action
+  where
+    name = takeBaseName path
+    diff golden output = ["diff", "-u", golden, output]
+    golden = path `replaceExtension` ".golden.cabal"
+    action = SUT.convert =<< SUT.contents path

test/initialise/ConfigurationSpec.hs

@@ -0,0 +1,38 @@
+module MetaDataSpec (spec) where
+
+import qualified MetaData as SUT
+import Options.Applicative (execParserPure)
+import Test.Hspec (Spec, describe, it)
+
+spec :: Spec
+spec =
+  describe "MetaData" $ do
+    describe "parser" $ do
+      it "should error if homepage isn't a URI" $ do
+        (error, exitCode) <-
+          renderFailure
+            <$> execParserPure
+              defaultPrefs
+              (info (SUT.parser defaults <**> helper))
+              ["--homepage", "not-a-url"]
+        exitCode `shouldNotBe` 0
+        error `shouldBe` ""
+      it "should error if licence isn't an SPDX licence ID" $ do
+        (error, exitCode) <-
+          renderFailure
+            <$> execParserPure
+              defaultPrefs
+              (info (SUT.parser defaults <**> helper))
+              ["--licence", "not-a-licence"]
+        exitCode `shouldNotBe` 0
+        error `shouldBe` ""
+
+defaults :: SUT.Defaults
+defaults =
+  SUT.Defaults
+    { SUT.dOrigin = fromJust (parseURI "http://github.com/username/repository.git"),
+      SUT.dAuthor = "Forename Surname",
+      SUT.dMaintainer = "[email protected]",
+      SUT.dPath = ".",
+      SUT.dYear = 1970
+    }

test/initialise/DefaultsSpec.hs

@@ -7,16 +7,6 @@ import qualified Defaults as SUT
 import Network.URI (parseURI)
 import Test.Hspec (Spec, describe, it, shouldBe)
 
-defaults :: SUT.Defaults
-defaults =
-  SUT.Defaults
-    { SUT.dOrigin = fromJust (parseURI "http://github.com/username/repository.git"),
-      SUT.dAuthor = "Forename Surname",
-      SUT.dMaintainer = "[email protected]",
-      SUT.dPath = ".",
-      SUT.dYear = 1970
-    }
-
 spec :: Spec
 spec = describe "Defaults" $ do
   describe "dName" $ do
@@ -36,3 +26,13 @@ spec = describe "Defaults" $ do
             SUT.dPath = "/workspaces/template.hs",
             SUT.dYear = 2023
           }
+
+defaults :: SUT.Defaults
+defaults =
+  SUT.Defaults
+    { SUT.dOrigin = fromJust (parseURI "http://github.com/username/repository.git"),
+      SUT.dAuthor = "Forename Surname",
+      SUT.dMaintainer = "[email protected]",
+      SUT.dPath = ".",
+      SUT.dYear = 1970
+    }

test/initialise/InitialiseSpec.hs

@@ -0,0 +1,7 @@
+module InitialiseSpec (spec) where
+
+import Test.Hspec (Spec, describe)
+
+spec :: Hspec
+spec = describe "Initialise" $ do
+  undefined

test/initialise/Main.hs

@@ -1,5 +1,6 @@
 module Main (main) where
 
+import qualified CabalGolden (golden)
 import qualified DefaultsSpec (spec)
 import qualified GitSpec (spec)
 import Test.Tasty (defaultMain, testGroup)
@@ -14,8 +15,10 @@ main = do
         [ DefaultsSpec.spec,
           GitSpec.spec
         ]
+  goldens <- sequence [CabalGolden.golden]
   defaultMain $
     testGroup
       "initialise-library"
-      [ testGroup "Specs" specs
+      [ testGroup "Specs" specs,
+        testGroup "Golden" goldens
       ]