freckle-app 1.0.0.1 → 1.0.0.2
raw patch · 6 files changed
+116/−66 lines, 6 files
Files
- CHANGELOG.md +4/−0
- freckle-app.cabal +39/−7
- gittest/Freckle/App/VersionSpec.hs +59/−0
- gittest/Main.hs +13/−0
- gittest/Spec.hs +1/−0
- tests/Freckle/App/VersionSpec.hs +0/−59
CHANGELOG.md view
@@ -1,3 +1,7 @@+## [v1.0.0.2](https://github.com/freckle/freckle-app/compare/v1.0.0.1...v1.0.0.2)++- Extract tests that require `git` into a new suite.+ ## [v1.0.0.1](https://github.com/freckle/freckle-app/compare/v1.0.0.0...v1.0.0.1) - Ensure `release` GitHub Action completes properly.
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: freckle-app-version: 1.0.0.1+version: 1.0.0.2 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -18,6 +18,10 @@ type: git location: https://github.com/freckle/freckle-app +flag test-git+ description: Run tests that run git commands+ manual: True+ library exposed-modules: Freckle.App@@ -125,6 +129,40 @@ base >=4.14.1.0 && <5, freckle-app -any +test-suite gittest+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: gittest+ other-modules:+ Freckle.App.VersionSpec+ Spec+ Paths_freckle_app++ default-language: Haskell2010+ default-extensions:+ BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ build-depends:+ base >=4.14.1.0 && <5,+ directory >=1.3.6.0,+ freckle-app -any,+ hspec >=2.7.10,+ process >=1.6.9.0,+ temporary >=1.3,+ text >=1.2.4.1,+ time >=1.9.3++ if flag(test-git)++ else+ buildable: False+ test-suite spec type: exitcode-stdio-1.0 main-is: Main.hs@@ -132,7 +170,6 @@ other-modules: Freckle.App.Env.InternalSpec Freckle.App.HttpSpec- Freckle.App.VersionSpec Freckle.App.WaiSpec Spec Paths_freckle_app@@ -152,15 +189,10 @@ aeson >=1.5.6.0, base >=4.14.1.0 && <5, bytestring >=0.10.12.0,- directory >=1.3.6.0, freckle-app -any, hspec >=2.7.10, http-types >=0.12.3, lens >=4.19.2, lens-aeson >=1.1.1,- process >=1.6.9.0,- temporary >=1.3,- text >=1.2.4.1,- time >=1.9.3, wai >=3.2.3, wai-extra >=3.1.6
+ gittest/Freckle/App/VersionSpec.hs view
@@ -0,0 +1,59 @@+module Freckle.App.VersionSpec+ ( spec+ )+where++import Prelude++import Data.Bifunctor (first)+import Data.Maybe (fromMaybe)+import Data.Text (unpack)+import Data.Time (UTCTime)+import Data.Time.Format (defaultTimeLocale, parseTimeM)+import Freckle.App.Version+import System.Directory (withCurrentDirectory)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (callProcess, readProcess)+import Test.Hspec++spec :: Spec+spec = do+ describe "getAppVersion" $ do+ -- NB. This is a single test case because the temporary directory and git+ -- stuff steps all over itself when run in parallel.+ --+ -- This could be a bug in withSystemTempDirectory or withCurrentDirectory?+ --+ it "tries files, then git, and records failed attempts" $ do+ inTemporaryDirectory $ \tmp -> do+ eVersion1 <- tryGetAppVersion tmp+ first (map $ unwords . take 6 . words) eVersion1 `shouldBe` Left+ [ "readFile: " <> tmp <> "/name: openFile: does not exist"+ , "[128] git rev-parse HEAD: fatal: not"+ ]++ callProcess "git" ["init", "--quiet"]+ callProcess "git" ["commit", "--quiet", "--allow-empty", "-m", "x"]+ sha <- readProcess "git" ["rev-parse", "HEAD"] ""++ eVersion2 <- tryGetAppVersion tmp+ fmap (unpack . (<> "\n") . avName) eVersion2 `shouldBe` Right sha++ let seconds = "1582301740"+ writeFile "name" "a version"+ writeFile "created-at" seconds++ eVersion3 <- tryGetAppVersion tmp+ eVersion3 `shouldBe` Right AppVersion+ { avName = "a version"+ , avCreatedAt = parseTimeUnsafe "%s" seconds+ }++inTemporaryDirectory :: (FilePath -> IO a) -> IO a+inTemporaryDirectory f = withSystemTempDirectory "freckle-app-tests"+ $ \tmp -> withCurrentDirectory tmp $ f tmp++parseTimeUnsafe :: String -> String -> UTCTime+parseTimeUnsafe fmt str = fromMaybe err+ $ parseTimeM True defaultTimeLocale fmt str+ where err = error $ str <> " did not parse as UTCTime format " <> fmt
+ gittest/Main.hs view
@@ -0,0 +1,13 @@+module Main+ ( main+ )+where++import Prelude++import Freckle.App.Test.Hspec.Runner (runParConfig)+import qualified Spec+import Test.Hspec++main :: IO ()+main = "freckle-app" `runParConfig` parallel Spec.spec
+ gittest/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec -optF --no-main #-}
− tests/Freckle/App/VersionSpec.hs
@@ -1,59 +0,0 @@-module Freckle.App.VersionSpec- ( spec- )-where--import Prelude--import Data.Bifunctor (first)-import Data.Maybe (fromMaybe)-import Data.Text (unpack)-import Data.Time (UTCTime)-import Data.Time.Format (defaultTimeLocale, parseTimeM)-import Freckle.App.Version-import System.Directory (withCurrentDirectory)-import System.IO.Temp (withSystemTempDirectory)-import System.Process (callProcess, readProcess)-import Test.Hspec--spec :: Spec-spec = do- describe "getAppVersion" $ do- -- NB. This is a single test case because the temporary directory and git- -- stuff steps all over itself when run in parallel.- --- -- This could be a bug in withSystemTempDirectory or withCurrentDirectory?- --- it "tries files, then git, and records failed attempts" $ do- inTemporaryDirectory $ \tmp -> do- eVersion1 <- tryGetAppVersion tmp- first (map $ unwords . take 6 . words) eVersion1 `shouldBe` Left- [ "readFile: " <> tmp <> "/name: openFile: does not exist"- , "[128] git rev-parse HEAD: fatal: not"- ]-- callProcess "git" ["init", "--quiet"]- callProcess "git" ["commit", "--quiet", "--allow-empty", "-m", "x"]- sha <- readProcess "git" ["rev-parse", "HEAD"] ""-- eVersion2 <- tryGetAppVersion tmp- fmap (unpack . (<> "\n") . avName) eVersion2 `shouldBe` Right sha-- let seconds = "1582301740"- writeFile "name" "a version"- writeFile "created-at" seconds-- eVersion3 <- tryGetAppVersion tmp- eVersion3 `shouldBe` Right AppVersion- { avName = "a version"- , avCreatedAt = parseTimeUnsafe "%s" seconds- }--inTemporaryDirectory :: (FilePath -> IO a) -> IO a-inTemporaryDirectory f = withSystemTempDirectory "freckle-app-tests"- $ \tmp -> withCurrentDirectory tmp $ f tmp--parseTimeUnsafe :: String -> String -> UTCTime-parseTimeUnsafe fmt str = fromMaybe err- $ parseTimeM True defaultTimeLocale fmt str- where err = error $ str <> " did not parse as UTCTime format " <> fmt