1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00
semantic/test/DiffCommandSpec.hs
2017-03-08 13:56:08 -08:00

93 lines
4.3 KiB
Haskell

module DiffCommandSpec where
import Data.Aeson
import Data.Aeson.Types
import Data.Maybe
import Data.Functor.Both
import Prelude
import Prologue (($), fmap, (.), pure, for, panic)
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
import Test.Hspec.Expectations.Pretty
import Test.Hspec.LeanCheck
import Data.Text.Lazy as T
import qualified Data.ByteString.Lazy as BL
import Data.Map
import qualified Data.Vector as V
import Arguments
import DiffCommand
import Renderer
import qualified Git.Types as Git
spec :: Spec
spec = parallel $ do
context "diff" $ do
prop "all formats should produce output for file paths" $
\format -> do
output <- diff $ diffPathsArgs "" (both "test/fixtures/ruby/and-or.A.rb" "test/fixtures/ruby/and-or.B.rb") format
output `shouldNotBe` ""
prop "all formats should produce output for commit range" $
\format -> do
output <- diff $ args "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" ["methods.rb"] format
output `shouldNotBe` ""
describe "fetchDiffs" $ do
it "generates diff summaries for two shas" $ do
(errors, summaries) <- fetchDiffsOutput summaryText $ args "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" ["methods.rb"] Renderer.Summary
errors `shouldBe` Just (fromList [])
summaries `shouldBe` Just (fromList [("methods.rb", ["Added the 'foo()' method"])])
it "generates toc summaries for two shas" $ do
(errors, summaries) <- fetchDiffsOutput termText $ args "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" ["methods.rb"] Renderer.TOC
errors `shouldBe` Just (fromList [])
summaries `shouldBe` Just (fromList [("methods.rb", ["foo"])])
it "generates toc summaries for two shas inferring paths" $ do
(errors, summaries) <- fetchDiffsOutput termText $ args "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" [] Renderer.TOC
errors `shouldBe` Just (fromList [])
summaries `shouldBe` Just (fromList [("methods.rb", ["foo"])])
it "errors with bad shas" $
fetchDiffsOutput summaryText (args "test/fixtures/git/examples/all-languages.git" "dead" "beef" ["methods.rb"] Renderer.Summary)
`shouldThrow` (== Git.BackendError "Could not lookup dead: Object not found - no match for prefix (dead000000000000000000000000000000000000)")
it "errors with bad repo path" $
fetchDiffsOutput summaryText (args "test/fixtures/git/examples/not-a-repo.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" ["methods.rb"] Renderer.Summary)
`shouldThrow` errorCall "Could not open repository \"test/fixtures/git/examples/not-a-repo.git\""
fetchDiffsOutput :: (Object -> Text) -> Arguments -> IO (Maybe (Map Text Value), Maybe (Map Text [Text]))
fetchDiffsOutput f arguments = do
diffs <- fetchDiffs arguments
let json = fromJust . decode . BL.fromStrict $ concatOutputs diffs
pure (errors json, summaries f json)
-- Diff Summaries payloads look like this:
-- {
-- "changes": { "methods.rb": [{ "span":{"insert":{"start":[1,1],"end":[2,4]}}, "summary":"Added the 'foo()' method" }] },
-- "errors":{}
-- }
-- TOC Summaries payloads look like this:
-- {
-- "changes": { "methods.rb": [{ "span":{"start":[1,1],"end":[2,4]}, "category":"Method", "term":"foo", "changeType":"added" }]
-- },
-- "errors":{}
-- }
summaries :: (Object -> Text) -> Object -> Maybe (Map Text [Text])
summaries f = parseMaybe $ \o -> do
changes <- o .: "changes" :: Parser (Map Text (V.Vector Object))
xs <- for (toList changes) $ \(path, s) -> do
let ys = fmap f s
pure (path, V.toList ys)
pure $ fromList xs
summaryText :: Object -> Text
summaryText o = fromMaybe (panic "key 'summary' not found") $
parseMaybe (.: "summary") o
termText :: Object -> Text
termText o = fromMaybe (panic "key 'term' not found") $
parseMaybe (.: "term") o
errors :: Object -> Maybe (Map Text Value)
errors = parseMaybe (.: "errors")