Remove nonEmptyOrFail function from recent tests (#1237)

* Remove nonEmptyOrFail * More nonempty literals * Whitespace tweak * Update changelog
yesodweb · Apr 26, 2021 · 2fd0e9b · 2fd0e9b
1 parent 93f6884
commit 2fd0e9b
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 42 deletions.
diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md
@@ -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)

diff --git a/persistent/test/main.hs b/persistent/test/main.hs
@@ -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
@@ -54,32 +54,36 @@ main = hspec $ do
                 `shouldBe`
                     ( [NEL.toList helloWorldTokens, NEL.toList foobarbazTokens], mempty )
         it "works4" $ do
-            let foobarbarz = ["foo", "Bar", "baz"]
-                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
@@ -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"
@@ -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"
                         ]
@@ -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"
                         ]
@@ -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"
@@ -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"
                         ]
@@ -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"
                         ]
@@ -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"
                         ]
@@ -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\""
                         ]
@@ -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\""
@@ -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 =
@@ -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
 
@@ -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']