Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Remove nonEmptyOrFail function from recent tests #1237

Merged
merged 4 commits into from
Apr 26, 2021
Merged

Remove nonEmptyOrFail function from recent tests #1237

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
6c5cccf
Remove nonEmptyOrFail
danbroooks Apr 20, 2021
0c51b1e
More nonempty literals
danbroooks Apr 21, 2021
0bacd80
Whitespace tweak
danbroooks Apr 21, 2021
2d74a29
Update changelog
danbroooks Apr 21, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions persistent/ChangeLog.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# Changelog for persistent

## Unreleased

* [#1237](https://github.com/yesodweb/persistent/pull/1237)
* Remove nonEmptyOrFail function from recent tests

## 2.12.1.1

* [#1231](https://github.com/yesodweb/persistent/pull/1231)
Expand Down
83 changes: 41 additions & 42 deletions persistent/test/main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,23 +3,23 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import qualified Data.Char as Char
import qualified Data.Text as T
import Data.List
import Data.List.NonEmpty (NonEmpty(..), (<|))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as Map
import qualified Data.Text as T
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
#if !MIN_VERSION_base(4,11,0)
-- This can be removed when GHC < 8.2.2 isn't supported anymore
import Data.Semigroup ((<>))
#endif
import Data.Time
import Text.Shakespeare.Text
import Data.Aeson
import qualified Data.ByteString.Char8 as BS8
import Data.Time
import Text.Shakespeare.Text

import Database.Persist.Class.PersistField
import Database.Persist.Quasi
Expand Down Expand Up @@ -54,32 +54,36 @@ main = hspec $ do
`shouldBe`
( [NEL.toList helloWorldTokens, NEL.toList foobarbazTokens], mempty )
it "works4" $ do
let foobarbarz = ["foo", "Bar", "baz"]
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These were also causing some type ambiguity errors, where with OverloadedLists we want to use this value here both as a [Text] and NonEmpty Text, so I have opted to re-writing the test with literals rather than trying to re-use the values. I've tried to include some more realworld looking values too while changing things here.

fbbTokens = Token <$> nonEmptyOrFail foobarbarz
splitExtras
[ Line 0 (pure (Token "Hello"))
, Line 2 fbbTokens
, Line 2 fbbTokens
[ Line 0 [Token "Product"]
, Line 2 (Token <$> ["name", "Text"])
, Line 2 (Token <$> ["added", "UTCTime", "default=CURRENT_TIMESTAMP"])
]
`shouldBe`
( []
, Map.fromList
[ ("Hello", [foobarbarz, foobarbarz])
]
[ ("Product",
[ ["name", "Text"]
, ["added", "UTCTime", "default=CURRENT_TIMESTAMP"]
]
) ]
)
it "works5" $ do
let foobarbarz = ["foo", "Bar", "baz"]
fbbTokens = Token <$> nonEmptyOrFail foobarbarz
splitExtras
[ Line 0 (pure (Token "Hello"))
, Line 2 fbbTokens
, Line 4 fbbTokens
[ Line 0 [Token "Product"]
, Line 2 (Token <$> ["name", "Text"])
, Line 4 [Token "ExtraBlock"]
, Line 4 (Token <$> ["added", "UTCTime", "default=CURRENT_TIMESTAMP"])
]
`shouldBe`
( []
, Map.fromList
[ ("Hello", [foobarbarz, foobarbarz])
]
[ ("Product",
[ ["name", "Text"]
, ["ExtraBlock"]
, ["added", "UTCTime", "default=CURRENT_TIMESTAMP"]
]
)]
)
describe "takeColsEx" $ do
let subject = takeColsEx upperCaseSettings
Expand Down Expand Up @@ -140,7 +144,7 @@ main = hspec $ do
it "handles normal words" $
parseLine " foo bar baz" `shouldBe`
Just
( Line 1 $ nonEmptyOrFail
( Line 1
[ Token "foo"
, Token "bar"
, Token "baz"
Expand All @@ -150,7 +154,7 @@ main = hspec $ do
it "handles quotes" $
parseLine " \"foo bar\" \"baz\"" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "foo bar"
, Token "baz"
]
Expand All @@ -159,7 +163,7 @@ main = hspec $ do
it "handles quotes mid-token" $
parseLine " x=\"foo bar\" \"baz\"" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "x=foo bar"
, Token "baz"
]
Expand All @@ -168,7 +172,7 @@ main = hspec $ do
it "handles escaped quote mid-token" $
parseLine " x=\\\"foo bar\" \"baz\"" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "x=\\\"foo"
, Token "bar\""
, Token "baz"
Expand All @@ -178,7 +182,7 @@ main = hspec $ do
it "handles unnested parantheses" $
parseLine " (foo bar) (baz)" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "foo bar"
, Token "baz"
]
Expand All @@ -187,7 +191,7 @@ main = hspec $ do
it "handles unnested parantheses mid-token" $
parseLine " x=(foo bar) (baz)" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "x=foo bar"
, Token "baz"
]
Expand All @@ -196,7 +200,7 @@ main = hspec $ do
it "handles nested parantheses" $
parseLine " (foo (bar)) (baz)" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "foo (bar)"
, Token "baz"
]
Expand All @@ -205,7 +209,7 @@ main = hspec $ do
it "escaping" $
parseLine " (foo \\(bar) y=\"baz\\\"\"" `shouldBe`
Just
( Line 2 $ nonEmptyOrFail
( Line 2
[ Token "foo (bar"
, Token "y=baz\""
]
Expand All @@ -214,7 +218,7 @@ main = hspec $ do
it "mid-token quote in later token" $
parseLine "foo bar baz=(bin\")" `shouldBe`
Just
( Line 0 $ nonEmptyOrFail
( Line 0
[ Token "foo"
, Token "bar"
, Token "baz=bin\""
Expand All @@ -225,13 +229,14 @@ main = hspec $ do
it "recognizes one line" $ do
parseLine "-- | this is a comment" `shouldBe`
Just
( Line 0 $ pure
(DocComment "this is a comment")
( Line 0
[ DocComment "this is a comment"
]
)

it "works if comment is indented" $ do
parseLine " -- | comment" `shouldBe`
Just (Line 2 (pure (DocComment "comment")))
Just (Line 2 [DocComment "comment"])

describe "parse" $ do
let subject =
Expand Down Expand Up @@ -576,10 +581,10 @@ Baz
, " name String"
]
expected =
Line { lineIndent = 0, tokens = pure (DocComment "Model") } :|
[ Line { lineIndent = 0, tokens = pure (Token "Foo") }
, Line { lineIndent = 2, tokens = pure (DocComment "Field") }
, Line { lineIndent = 2, tokens = Token "name" :| [Token "String"] }
Line { lineIndent = 0, tokens = [DocComment "Model"] } :|
[ Line { lineIndent = 0, tokens = [Token "Foo"] }
, Line { lineIndent = 2, tokens = [DocComment "Field"] }
, Line { lineIndent = 2, tokens = (Token <$> ["name", "String"]) }
]
preparse text `shouldBe` Just expected

Expand Down Expand Up @@ -881,12 +886,6 @@ takePrefix :: Value -> Value
takePrefix (String a) = String (T.take 1 a)
takePrefix a = a

nonEmptyOrFail :: [a] -> NonEmpty a
nonEmptyOrFail = maybe failure id . NEL.nonEmpty
where
failure =
error "nonEmptyOrFail expected a non empty list"

arbitraryWhiteSpaceChar :: Gen Char
arbitraryWhiteSpaceChar =
oneof $ pure <$> [' ', '\t', '\n', '\r']