unbeliever 0.10.0.6 → 0.10.0.7
raw patch · 9 files changed
+462/−478 lines, 9 filesdep +prettyprinterdep +unordered-containersdep ~core-datadep ~core-programPVP ok
version bump matches the API change (PVP)
Dependencies added: prettyprinter, unordered-containers
Dependency ranges changed: core-data, core-program
API changes (from Hackage documentation)
Files
- tests/CheckArgumentsParsing.hs +121/−137
- tests/CheckBytesBehaviour.hs +10/−12
- tests/CheckContainerBehaviour.hs +38/−40
- tests/CheckJsonWrapper.hs +30/−24
- tests/CheckProgramMonad.hs +55/−54
- tests/CheckRopeBehaviour.hs +172/−176
- tests/Everything.hs +14/−14
- tests/TestSuite.hs +11/−12
- unbeliever.cabal +11/−9
tests/CheckArgumentsParsing.hs view
@@ -1,180 +1,164 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module CheckArgumentsParsing- ( checkArgumentsParsing- , main- )- where--import Test.Hspec+ ( checkArgumentsParsing,+ main,+ )+where import Core.Program.Arguments import Core.System.Base+import Test.Hspec main :: IO () main = do- finally (hspec checkArgumentsParsing) (putStrLn ".")+ finally (hspec checkArgumentsParsing) (putStrLn ".") options1 :: [Options] options1 =- [ Option "verbose" (Just 'v') Empty "Make the program verbose"- , Option "quiet" (Just 'q') Empty "Be very very quiet, we're hunting wabbits"- , Option "dry-run" Nothing (Value "WHEN") "Before trapping Road Runner, best to do a dry-run"- ]+ [ Option "verbose" (Just 'v') Empty "Make the program verbose",+ Option "quiet" (Just 'q') Empty "Be very very quiet, we're hunting wabbits",+ Option "dry-run" Nothing (Value "WHEN") "Before trapping Road Runner, best to do a dry-run"+ ] options2 :: [Options] options2 =- [ Option "recursive" Nothing Empty "Descend into darkness"- , Argument "filename" "The file that you want"- ]+ [ Option "recursive" Nothing Empty "Descend into darkness",+ Argument "filename" "The file that you want"+ ] options3 :: [Options] options3 =- [ Option "all" (Just 'a') Empty "Good will to everyone"- ]-+ [ Option "all" (Just 'a') Empty "Good will to everyone"+ ] commands1 :: [Commands] commands1 =- [ Global- options1- , Command "add" "Add a new file"- options2- ]+ [ Global+ options1,+ Command+ "add"+ "Add a new file"+ options2+ ] commands2 :: [Commands] commands2 =- [ Global- options1- , Command "add" "Add a new file"- options2- , Command "commit" "Commit for eternity"- options3- ]-+ [ Global+ options1,+ Command+ "add"+ "Add a new file"+ options2,+ Command+ "commit"+ "Commit for eternity"+ options3+ ] checkArgumentsParsing :: Spec checkArgumentsParsing = do- describe "Parsing of simple command-lines" $ do- it "recognizes a single specified options" $- let- config = simple options1- actual = parseCommandLine config ["--verbose"]- expect = Parameters Nothing [("verbose", Empty)] []- in- actual `shouldBe` Right expect- it "recognizes all specified options" $- let- config = simple options1- actual = parseCommandLine config ["--verbose", "--quiet", "--dry-run=Tomorrow"]- expect = Parameters Nothing- [ ("verbose", Empty)- , ("quiet", Empty)- , ("dry-run", Value "Tomorrow")- ] []- in- actual `shouldBe` Right expect+ describe "Parsing of simple command-lines" $ do+ it "recognizes a single specified options" $+ let config = simple options1+ actual = parseCommandLine config ["--verbose"]+ expect = Parameters Nothing [("verbose", Empty)] []+ in actual `shouldBe` Right expect+ it "recognizes all specified options" $+ let config = simple options1+ actual = parseCommandLine config ["--verbose", "--quiet", "--dry-run=Tomorrow"]+ expect =+ Parameters+ Nothing+ [ ("verbose", Empty),+ ("quiet", Empty),+ ("dry-run", Value "Tomorrow")+ ]+ []+ in actual `shouldBe` Right expect - it "recognizes required arguments" $- let- config = simple options2- actual = parseCommandLine config ["hello.txt"]- expect = Parameters Nothing+ it "recognizes required arguments" $+ let config = simple options2+ actual = parseCommandLine config ["hello.txt"]+ expect =+ Parameters+ Nothing [ ("filename", Value "hello.txt")- ] []- in- actual `shouldBe` Right expect+ ]+ []+ in actual `shouldBe` Right expect - it "handles valued parameter" $- let- config = simple options2- actual = parseCommandLine config ["hello.txt"]- expect = Parameters Nothing+ it "handles valued parameter" $+ let config = simple options2+ actual = parseCommandLine config ["hello.txt"]+ expect =+ Parameters+ Nothing [ ("filename", Value "hello.txt")- ] []- in- actual `shouldBe` Right expect-- it "rejects unknown options" $- let- config = simple options2- actual = parseCommandLine config ["-a"]- in- actual `shouldBe` Left (UnknownOption "-a")-- it "rejects a malformed option" $- let- config = simple options2- actual = parseCommandLine config ["-help"]- in- actual `shouldBe` Left (InvalidOption "-help")-- it "fails on missing argument" $- let- config = simple options2- actual = parseCommandLine config []- in- actual `shouldBe` Left (MissingArgument "filename")+ ]+ []+ in actual `shouldBe` Right expect - it "accepts request for version" $- let- config = simple options1- actual = parseCommandLine config ["--version"]- in- actual `shouldBe` Left VersionRequest+ it "rejects unknown options" $+ let config = simple options2+ actual = parseCommandLine config ["-a"]+ in actual `shouldBe` Left (UnknownOption "-a") + it "rejects a malformed option" $+ let config = simple options2+ actual = parseCommandLine config ["-help"]+ in actual `shouldBe` Left (InvalidOption "-help") - describe "Parsing of complex command-lines" $ do+ it "fails on missing argument" $+ let config = simple options2+ actual = parseCommandLine config []+ in actual `shouldBe` Left (MissingArgument "filename") - it "recognizes only single command" $- let- config = complex commands1- actual = parseCommandLine config ["-q", "add", "--recursive", "Hello.hs"]- expect = Parameters (Just "add")- [ ("quiet", Empty)- , ("recursive", Empty)- , ("filename", Value "Hello.hs")- ] []- in- actual `shouldBe` Right expect+ it "accepts request for version" $+ let config = simple options1+ actual = parseCommandLine config ["--version"]+ in actual `shouldBe` Left VersionRequest - it "fails on missing command" $- let- config = complex commands1- actual = parseCommandLine config []- in- actual `shouldBe` Left (NoCommandFound)+ describe "Parsing of complex command-lines" $ do+ it "recognizes only single command" $+ let config = complex commands1+ actual = parseCommandLine config ["-q", "add", "--recursive", "Hello.hs"]+ expect =+ Parameters+ (Just "add")+ [ ("quiet", Empty),+ ("recursive", Empty),+ ("filename", Value "Hello.hs")+ ]+ []+ in actual `shouldBe` Right expect - it "rejects an unknown command" $- let- config = complex commands1- actual = parseCommandLine config ["launch"]- in- actual `shouldBe` Left (UnknownCommand "launch")+ it "fails on missing command" $+ let config = complex commands1+ actual = parseCommandLine config []+ in actual `shouldBe` Left (NoCommandFound) - it "recognizes different command" $ -- ie, now from among multiple choices- let- config = complex commands2- actual = parseCommandLine config ["commit"]- expect = Parameters (Just "commit") [] []- in- actual `shouldBe` Right expect+ it "rejects an unknown command" $+ let config = complex commands1+ actual = parseCommandLine config ["launch"]+ in actual `shouldBe` Left (UnknownCommand "launch") - it "rejects further trailing arguments" $- let- config = complex commands2- actual = parseCommandLine config ["commit", "some"]- in- actual `shouldBe` Left (UnexpectedArguments ["some"])+ it "recognizes different command" $ -- ie, now from among multiple choices+ let config = complex commands2+ actual = parseCommandLine config ["commit"]+ expect = Parameters (Just "commit") [] []+ in actual `shouldBe` Right expect --- in complex mode wasn't accpting --version as a global option.+ it "rejects further trailing arguments" $+ let config = complex commands2+ actual = parseCommandLine config ["commit", "some"]+ in actual `shouldBe` Left (UnexpectedArguments ["some"]) - it "accepts request for version" $- let- config = complex commands2- actual = parseCommandLine config ["--version"]- in- actual `shouldBe` Left VersionRequest+ -- in complex mode wasn't accpting --version as a global option. + it "accepts request for version" $+ let config = complex commands2+ actual = parseCommandLine config ["--version"]+ in actual `shouldBe` Left VersionRequest
tests/CheckBytesBehaviour.hs view
@@ -4,21 +4,19 @@ module CheckBytesBehaviour where -import qualified Data.ByteString.Char8 as C-import Test.Hspec- import Core.Text.Bytes () import Core.Text.Utilities (byteChunk)+import qualified Data.ByteString.Char8 as C+import Test.Hspec checkBytesBehaviour :: Spec checkBytesBehaviour = do- describe "Bytes data type" $ do- it "chunks Bytes in 64 bit words" $- let- expected =- [ C.pack "Hello Wo"- , C.pack "rld! Goo"- , C.pack "d Bye."- ]- in do+ describe "Bytes data type" $ do+ it "chunks Bytes in 64 bit words" $+ let expected =+ [ C.pack "Hello Wo",+ C.pack "rld! Goo",+ C.pack "d Bye."+ ]+ in do byteChunk (C.pack "Hello World! Good Bye.") `shouldBe` expected
tests/CheckContainerBehaviour.hs view
@@ -3,59 +3,57 @@ module CheckContainerBehaviour where -import Test.Hspec- import Core.Data.Structures import Core.Text.Rope+import Test.Hspec climbing :: [Int]-climbing = [1,1,2,1,2,4,1,3,9]+climbing = [1, 1, 2, 1, 2, 4, 1, 3, 9] fibonacci :: [Int]-fibonacci = [1,1,2,3,5,8,13,21]+fibonacci = [1, 1, 2, 3, 5, 8, 13, 21] -introduction :: [(Int,Rope)]-introduction = [(2," "),(3,"world"),(1,"hello")]+introduction :: [(Int, Rope)]+introduction = [(2, " "), (3, "world"), (1, "hello")] checkContainerBehaviour :: Spec checkContainerBehaviour = do- describe "Set data type" $ do- it "calculates length accurately" $ do- length fibonacci `shouldBe` 8- let s = intoSet fibonacci- length s `shouldBe` 7-- it "converts to list in Ord order" $ do- let s = intoSet climbing- length s `shouldBe` 5- fromSet s `shouldBe` [1,2,3,4,9]+ describe "Set data type" $ do+ it "calculates length accurately" $ do+ length fibonacci `shouldBe` 8+ let s = intoSet fibonacci+ length s `shouldBe` 7 - describe "Map data type" $ do- it "calculates length accurately" $ do- length introduction `shouldBe` 3- let p = intoMap introduction- length p `shouldBe` 3+ it "converts to list in Ord order" $ do+ let s = intoSet climbing+ length s `shouldBe` 5+ fromSet s `shouldBe` [1, 2, 3, 4, 9] - it "values can be looked up" $ do- let p = intoMap introduction- containsKey 3 p `shouldBe` True- lookupKeyValue 3 p `shouldBe` (Just "world")- containsKey 4 p `shouldBe` False- lookupKeyValue 4 p `shouldBe` Nothing+ describe "Map data type" $ do+ it "calculates length accurately" $ do+ length introduction `shouldBe` 3+ let p = intoMap introduction+ length p `shouldBe` 3 - it "values can be inserted into Map" $ do- let p = intoMap introduction- let p' = insertKeyValue 4 "!" p- containsKey 4 p' `shouldBe` True- lookupKeyValue 4 p' `shouldBe` (Just "!")+ it "values can be looked up" $ do+ let p = intoMap introduction+ containsKey 3 p `shouldBe` True+ lookupKeyValue 3 p `shouldBe` (Just "world")+ containsKey 4 p `shouldBe` False+ lookupKeyValue 4 p `shouldBe` Nothing - it "converts to list in Ord order" $ do- let p = intoMap introduction- fromMap p `shouldBe` [(1,"hello"),(2," "),(3,"world")]+ it "values can be inserted into Map" $ do+ let p = intoMap introduction+ let p' = insertKeyValue 4 "!" p+ containsKey 4 p' `shouldBe` True+ lookupKeyValue 4 p' `shouldBe` (Just "!") - it "updated values supercede existing values" $ do- let p = intoMap introduction- let p' = insertKeyValue 2 "&" p- containsKey 2 p' `shouldBe` True- lookupKeyValue 2 p' `shouldBe` (Just "&")+ it "converts to list in Ord order" $ do+ let p = intoMap introduction+ fromMap p `shouldBe` [(1, "hello"), (2, " "), (3, "world")] + it "updated values supercede existing values" $ do+ let p = intoMap introduction+ let p' = insertKeyValue 2 "&" p+ containsKey 2 p' `shouldBe` True+ lookupKeyValue 2 p' `shouldBe` (Just "&")
tests/CheckJsonWrapper.hs view
@@ -3,46 +3,52 @@ module CheckJsonWrapper where -import qualified Data.ByteString.Char8 as C-import Test.Hspec- import Core.Data-import Core.Text import Core.Encoding.Json+import Core.Text+import qualified Data.ByteString.Char8 as C+import Test.Hspec k = JsonKey "intro"+ v = JsonString "Hello" j = JsonObject (intoMap [(k, v)]) -j2 = JsonObject (intoMap- [ (JsonKey "song", JsonString "Thriller")- , (JsonKey "other", JsonString "A very long name for the \"shadow of the moon\".")- , (JsonKey "four", JsonObject (intoMap- [ (JsonKey "n1", r)- ]))- ])+j2 =+ JsonObject+ ( intoMap+ [ (JsonKey "song", JsonString "Thriller"),+ (JsonKey "other", JsonString "A very long name for the \"shadow of the moon\"."),+ ( JsonKey "four",+ JsonObject+ ( intoMap+ [ (JsonKey "n1", r)+ ]+ )+ )+ ]+ ) b = intoBytes (C.pack "{\"cost\": 4500}") r = JsonArray [JsonBool False, JsonNull, JsonNumber 42] - checkJsonWrapper :: Spec checkJsonWrapper = do- describe "JsonValue encoding" $- do- it "JSON String should be wrapped in quotes" $ do- encodeToUTF8 v `shouldBe` intoBytes (C.pack "\"Hello\"")+ describe "JsonValue encoding" $+ do+ it "JSON String should be wrapped in quotes" $ do+ encodeToUTF8 v `shouldBe` intoBytes (C.pack "\"Hello\"") - it "JSON Array renders correctly" $ do- encodeToUTF8 r `shouldBe` intoBytes (C.pack "[false,null,42]")+ it "JSON Array renders correctly" $ do+ encodeToUTF8 r `shouldBe` intoBytes (C.pack "[false,null,42]") - it "JSON Object renders correctly" $ do- encodeToUTF8 j `shouldBe` intoBytes (C.pack "{\"intro\":\"Hello\"}")+ it "JSON Object renders correctly" $ do+ encodeToUTF8 j `shouldBe` intoBytes (C.pack "{\"intro\":\"Hello\"}") - it "decoding an Object parses" $ do- decodeFromUTF8 b `shouldBe` Just (JsonObject (intoMap [(JsonKey "cost", JsonNumber 4500)]))+ it "decoding an Object parses" $ do+ decodeFromUTF8 b `shouldBe` Just (JsonObject (intoMap [(JsonKey "cost", JsonNumber 4500)])) - it "complex JSON Object round trips" $ do- decodeFromUTF8 (encodeToUTF8 j2) `shouldBe` Just j2+ it "complex JSON Object round trips" $ do+ decodeFromUTF8 (encodeToUTF8 j2) `shouldBe` Just j2
tests/CheckProgramMonad.hs view
@@ -1,33 +1,34 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module CheckProgramMonad where import qualified Control.Exception.Safe as Safe-import Test.Hspec hiding (context)- import Core.Data.Structures import Core.Program.Arguments import Core.Program.Execute import Core.Program.Unlift import Core.System.Base+import Test.Hspec hiding (context) options :: [Options] options =- [ Option "all" (Just 'a') Empty "Good will to everyone"- ]+ [ Option "all" (Just 'a') Empty "Good will to everyone"+ ] commands :: [Commands] commands =- [ Global- options- , Command "go-forth" "And multiply"- []- ]+ [ Global+ options,+ Command+ "go-forth"+ "And multiply"+ []+ ] data Boom = Boom- deriving Show+ deriving (Show) instance Exception Boom @@ -36,53 +37,53 @@ checkProgramMonad :: Spec checkProgramMonad = do- describe "Context type" $ do- it "Eq instance for None behaves" $ do- None `shouldBe` None+ describe "Context type" $ do+ it "Eq instance for None behaves" $ do+ None `shouldBe` None - describe "Program monad" $ do- it "execute with blank Context as expected" $ do- context <- configure "0.1" None blank- executeWith context $ do- user <- getApplicationState- liftIO $ do- user `shouldBe` None+ describe "Program monad" $ do+ it "execute with blank Context as expected" $ do+ context <- configure "0.1" None blank+ executeWith context $ do+ user <- getApplicationState+ liftIO $ do+ user `shouldBe` None - it "execute with simple Context as expected" $ do- context <- configure "0.1" None (simple options)- executeWith context $ do- params <- getCommandLine- liftIO $ do- -- this assumes that hspec isn't passing any- -- command-line arguments through to us.- params `shouldBe` (Parameters Nothing emptyMap emptyMap)+ it "execute with simple Context as expected" $ do+ context <- configure "0.1" None (simple options)+ executeWith context $ do+ params <- getCommandLine+ liftIO $ do+ -- this assumes that hspec isn't passing any+ -- command-line arguments through to us.+ params `shouldBe` (Parameters Nothing emptyMap emptyMap) - -- not strictly necessary but sets up next spec item- it "sub-programs can be run" $ do- context <- configure "0.1" None blank- user <- subProgram context (getApplicationState)- user `shouldBe` None+ -- not strictly necessary but sets up next spec item+ it "sub-programs can be run" $ do+ context <- configure "0.1" None blank+ user <- subProgram context (getApplicationState)+ user `shouldBe` None - it "unlifting from lifted IO works" $ do- execute $ do- user1 <- getApplicationState- withContext $ \runProgram -> do- user1 `shouldBe` None- user2 <- runProgram getApplicationState -- unlift!- user2 `shouldBe` user1+ it "unlifting from lifted IO works" $ do+ execute $ do+ user1 <- getApplicationState+ withContext $ \runProgram -> do+ user1 `shouldBe` None+ user2 <- runProgram getApplicationState -- unlift!+ user2 `shouldBe` user1 - it "thrown Exceptions can be caught" $ do- context <- configure "0.1" None blank- (subProgram context (throw Boom)) `shouldThrow` boom+ it "thrown Exceptions can be caught" $ do+ context <- configure "0.1" None blank+ (subProgram context (throw Boom)) `shouldThrow` boom - -- ok, so with that established, now try **safe-exceptions**'s- -- code. Note if we move the exception handling code from- -- `execute` to `subProgram` this will have to adapt.- Safe.catch- (subProgram context (throw Boom))- (\(_ :: Boom) -> return ())+ -- ok, so with that established, now try **safe-exceptions**'s+ -- code. Note if we move the exception handling code from+ -- `execute` to `subProgram` this will have to adapt.+ Safe.catch+ (subProgram context (throw Boom))+ (\(_ :: Boom) -> return ()) - it "MonadThrow and MonadCatch behave" $ do- context <- configure "0.1" None blank- subProgram context $ do- Safe.catch (Safe.throw Boom) (\(_ :: Boom) -> return ())+ it "MonadThrow and MonadCatch behave" $ do+ context <- configure "0.1" None blank+ subProgram context $ do+ Safe.catch (Safe.throw Boom) (\(_ :: Boom) -> return ())
tests/CheckRopeBehaviour.hs view
@@ -3,11 +3,14 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module CheckRopeBehaviour- ( checkRopeBehaviour- , main- )+ ( checkRopeBehaviour,+ main,+ ) where +import Core.System (finally)+import Core.Text.Rope+import Core.Text.Utilities import Data.Char (isSpace) import qualified Data.FingerTree as F import Data.Hashable (hash)@@ -18,15 +21,12 @@ import qualified Data.Text.Short as S import Test.Hspec -import Core.Text.Rope-import Core.Text.Utilities-import Core.System (finally)- main :: IO () main = do- finally (hspec checkRopeBehaviour) (putStrLn ".")+ finally (hspec checkRopeBehaviour) (putStrLn ".") hydrogen = "H₂" :: Rope+ sulfate = "SO₄" :: Rope sulfuric_acid = hydrogen <> sulfate@@ -35,221 +35,217 @@ checkRopeBehaviour :: Spec checkRopeBehaviour = do- describe "Rope data type" $ do- it "knows what a singleton is" $ do- singletonRope 'i' `shouldBe` "i"+ describe "Rope data type" $ do+ it "knows what a singleton is" $ do+ singletonRope 'i' `shouldBe` "i" - it "IsString instance behaves" $ do- unRope ("Hello" :: Rope) `shouldBe` F.singleton (S.pack "Hello")+ it "IsString instance behaves" $ do+ unRope ("Hello" :: Rope) `shouldBe` F.singleton (S.pack "Hello") - it "calculates length accurately" $ do- widthRope hydrogen `shouldBe` 2- widthRope sulfate `shouldBe` 3- widthRope (hydrogen <> sulfate) `shouldBe` 5+ it "calculates length accurately" $ do+ widthRope hydrogen `shouldBe` 2+ widthRope sulfate `shouldBe` 3+ widthRope (hydrogen <> sulfate) `shouldBe` 5 - it "Eq instance behaves" $ do- ("" :: Rope) == ("" :: Rope) `shouldBe` True- ("C" :: Rope) /= ("" :: Rope) `shouldBe` True- ("" :: Rope) /= ("F" :: Rope) `shouldBe` True- ("O" :: Rope) == ("O" :: Rope) `shouldBe` True- ("H₂" :: Rope) == ("H₂" :: Rope) `shouldBe` True- ("H₂" :: Rope) /= ("SO₄" :: Rope) `shouldBe` True+ it "Eq instance behaves" $ do+ ("" :: Rope) == ("" :: Rope) `shouldBe` True+ ("C" :: Rope) /= ("" :: Rope) `shouldBe` True+ ("" :: Rope) /= ("F" :: Rope) `shouldBe` True+ ("O" :: Rope) == ("O" :: Rope) `shouldBe` True+ ("H₂" :: Rope) == ("H₂" :: Rope) `shouldBe` True+ ("H₂" :: Rope) /= ("SO₄" :: Rope) `shouldBe` True - it "Hashable instance behaves" $ do- hash ("Hello" :: Rope) `shouldBe` hash (singletonRope 'H' <> intoRope ("ello" :: String))+ it "Hashable instance behaves" $ do+ hash ("Hello" :: Rope) `shouldBe` hash (singletonRope 'H' <> intoRope ("ello" :: String)) - -- depended on Textual instance for String being fixed and- -- the Eq instance being customized to ignore tree structure- it "concatonates two Ropes correctly (Monoid)" $ do- ("H₂" :: Rope) <> ("SO₄" :: Rope) `shouldBe` ("H₂SO₄" :: Rope)+ -- depended on Textual instance for String being fixed and+ -- the Eq instance being customized to ignore tree structure+ it "concatonates two Ropes correctly (Monoid)" $ do+ ("H₂" :: Rope) <> ("SO₄" :: Rope) `shouldBe` ("H₂SO₄" :: Rope) - it "concatonates two Ropes correctly (Textual)" $ do- appendRope ("SO₄" :: Rope) ("H₂" :: Rope) `shouldBe` ("H₂SO₄" :: Rope)+ it "concatonates two Ropes correctly (Textual)" $ do+ appendRope ("SO₄" :: Rope) ("H₂" :: Rope) `shouldBe` ("H₂SO₄" :: Rope) - it "replicates itself" $ do- replicateRope 3 "hello" `shouldBe` ("hellohellohello" :: Rope)- length (unRope (replicateRope 3 "hello")) `shouldBe` 3- replicateRope 3 "" `shouldBe` emptyRope- replicateRope 0 "hello" `shouldBe` emptyRope- replicateChar 3 'x' `shouldBe` ("xxx" :: Rope)- replicateChar 0 'x' `shouldBe` ("" :: Rope)+ it "replicates itself" $ do+ replicateRope 3 "hello" `shouldBe` ("hellohellohello" :: Rope)+ length (unRope (replicateRope 3 "hello")) `shouldBe` 3+ replicateRope 3 "" `shouldBe` emptyRope+ replicateRope 0 "hello" `shouldBe` emptyRope+ replicateChar 3 'x' `shouldBe` ("xxx" :: Rope)+ replicateChar 0 'x' `shouldBe` ("" :: Rope) - it "exports to ByteString" $- let- expected = T.encodeUtf8 (T.pack "H₂SO₄")- in do+ it "exports to ByteString" $+ let expected = T.encodeUtf8 (T.pack "H₂SO₄")+ in do fromRope sulfuric_acid `shouldBe` expected - it "exports to Text (Strict)" $ do- fromRope sulfuric_acid `shouldBe` T.pack "H₂SO₄"+ it "exports to Text (Strict)" $ do+ fromRope sulfuric_acid `shouldBe` T.pack "H₂SO₄" - it "exports to Text (Lazy)" $ do- fromRope sulfuric_acid `shouldBe` U.pack "H₂SO₄"+ it "exports to Text (Lazy)" $ do+ fromRope sulfuric_acid `shouldBe` U.pack "H₂SO₄" - it "does the splits" $ do- -- compare behaviour on Haskell lists- List.splitAt 0 ("123456789" :: String) `shouldBe` ("", "123456789")- List.splitAt 3 ("123456789" :: String) `shouldBe` ("123", "456789")+ it "does the splits" $ do+ -- compare behaviour on Haskell lists+ List.splitAt 0 ("123456789" :: String) `shouldBe` ("", "123456789")+ List.splitAt 3 ("123456789" :: String) `shouldBe` ("123", "456789") - -- expect same behaviour of Rope- splitRope 0 ("123456789" :: Rope) `shouldBe` ("", "123456789")- splitRope 3 ("123456789" :: Rope) `shouldBe` ("123", "456789")- splitRope 9 ("123456789" :: Rope) `shouldBe` ("123456789","")- splitRope 10 ("123456789" :: Rope) `shouldBe` ("123456789","")- splitRope (-1) ("123456789" :: Rope) `shouldBe` ("", "123456789")+ -- expect same behaviour of Rope+ splitRope 0 ("123456789" :: Rope) `shouldBe` ("", "123456789")+ splitRope 3 ("123456789" :: Rope) `shouldBe` ("123", "456789")+ splitRope 9 ("123456789" :: Rope) `shouldBe` ("123456789", "")+ splitRope 10 ("123456789" :: Rope) `shouldBe` ("123456789", "")+ splitRope (-1) ("123456789" :: Rope) `shouldBe` ("", "123456789") - -- exercise splitRopeting at and between piece boundaries- splitRope 0 compound `shouldBe` ("", "3-ethyl-4-methylhexane")- splitRope 1 compound `shouldBe` ("3", "-ethyl-4-methylhexane")- splitRope 2 compound `shouldBe` ("3-", "ethyl-4-methylhexane")- splitRope 4 compound `shouldBe` ("3-et", "hyl-4-methylhexane")- -- 1234567890- splitRope 10 compound `shouldBe` ("3-ethyl-4-", "methylhexane")- splitRope 11 compound `shouldBe` ("3-ethyl-4-m", "ethylhexane")- splitRope 16 compound `shouldBe` ("3-ethyl-4-methyl", "hexane")- splitRope 21 compound `shouldBe` ("3-ethyl-4-methylhexan", "e")- widthRope compound `shouldBe` 22- splitRope 22 compound `shouldBe` ("3-ethyl-4-methylhexane", "")- splitRope 23 compound `shouldBe` ("3-ethyl-4-methylhexane", "")- splitRope (-1) compound `shouldBe` ("", "3-ethyl-4-methylhexane")+ -- exercise splitRopeting at and between piece boundaries+ splitRope 0 compound `shouldBe` ("", "3-ethyl-4-methylhexane")+ splitRope 1 compound `shouldBe` ("3", "-ethyl-4-methylhexane")+ splitRope 2 compound `shouldBe` ("3-", "ethyl-4-methylhexane")+ splitRope 4 compound `shouldBe` ("3-et", "hyl-4-methylhexane")+ -- 1234567890+ splitRope 10 compound `shouldBe` ("3-ethyl-4-", "methylhexane")+ splitRope 11 compound `shouldBe` ("3-ethyl-4-m", "ethylhexane")+ splitRope 16 compound `shouldBe` ("3-ethyl-4-methyl", "hexane")+ splitRope 21 compound `shouldBe` ("3-ethyl-4-methylhexan", "e")+ widthRope compound `shouldBe` 22+ splitRope 22 compound `shouldBe` ("3-ethyl-4-methylhexane", "")+ splitRope 23 compound `shouldBe` ("3-ethyl-4-methylhexane", "")+ splitRope (-1) compound `shouldBe` ("", "3-ethyl-4-methylhexane") - it "does insertion correctly" $ do- insertRope 3 "two" "onethree" `shouldBe` "onetwothree"- insertRope 3 "Con" "Def 1" `shouldBe` "DefCon 1"- insertRope 0 "one" "twothree" `shouldBe` "onetwothree"- insertRope 6 "three" "onetwo" `shouldBe` "onetwothree"+ it "does insertion correctly" $ do+ insertRope 3 "two" "onethree" `shouldBe` "onetwothree"+ insertRope 3 "Con" "Def 1" `shouldBe` "DefCon 1"+ insertRope 0 "one" "twothree" `shouldBe` "onetwothree"+ insertRope 6 "three" "onetwo" `shouldBe` "onetwothree" - it "finds characters correctly" $ do- findIndexRope (== '3') compound `shouldBe` (Just 0)- findIndexRope (== '4') compound `shouldBe` (Just 8)- findIndexRope (== '!') compound `shouldBe` Nothing- findIndexRope (== 'e') compound `shouldBe` (Just 2)+ it "finds characters correctly" $ do+ findIndexRope (== '3') compound `shouldBe` (Just 0)+ findIndexRope (== '4') compound `shouldBe` (Just 8)+ findIndexRope (== '!') compound `shouldBe` Nothing+ findIndexRope (== 'e') compound `shouldBe` (Just 2) - describe "QuasiQuoted string literals" $ do- it "string literal is IsString" $ do- [quote|Hello|] `shouldBe` ("Hello" :: String)- [quote|Hello|] `shouldBe` ("Hello" :: Rope)+ describe "QuasiQuoted string literals" $ do+ it "string literal is IsString" $ do+ [quote|Hello|] `shouldBe` ("Hello" :: String)+ [quote|Hello|] `shouldBe` ("Hello" :: Rope) - it "trims multi-line string literal" $ do- [quote|+ it "trims multi-line string literal" $ do+ [quote| Hello- |] `shouldBe` ("Hello\n" :: Rope)- [quote|+ |]+ `shouldBe` ("Hello\n" :: Rope)+ [quote| Hello World- |] `shouldBe` ("Hello\nWorld\n" :: Rope)+ |]+ `shouldBe` ("Hello\nWorld\n" :: Rope) - describe "Splitting into words" $ do- it "breaks short text into chunks" $ do- intoChunks isSpace "" `shouldBe` []- intoChunks isSpace "Hello" `shouldBe` ["Hello"]- intoChunks isSpace "Hello World" `shouldBe` ["Hello","World"]- intoChunks isSpace "Hello " `shouldBe` ["Hello",""]- intoChunks isSpace " Hello" `shouldBe` ["","Hello"]- intoChunks isSpace " Hello " `shouldBe` ["","Hello",""]+ describe "Splitting into words" $ do+ it "breaks short text into chunks" $ do+ intoChunks isSpace "" `shouldBe` []+ intoChunks isSpace "Hello" `shouldBe` ["Hello"]+ intoChunks isSpace "Hello World" `shouldBe` ["Hello", "World"]+ intoChunks isSpace "Hello " `shouldBe` ["Hello", ""]+ intoChunks isSpace " Hello" `shouldBe` ["", "Hello"]+ intoChunks isSpace " Hello " `shouldBe` ["", "Hello", ""] - it "breaks consecutive short texts into chunks" $ do- intoPieces isSpace "Hello" (Nothing,[]) `shouldBe`- (Just "Hello",[])- intoPieces isSpace "" (Nothing,[]) `shouldBe`- (Nothing,[])- intoPieces isSpace "" (Nothing,["World"]) `shouldBe`- (Nothing,["World"])- intoPieces isSpace "This is" (Nothing,["","a","","test."]) `shouldBe`- (Just "This",["is","","a","","test."])- intoPieces isSpace "This i" (Just "s",["","a","","test."]) `shouldBe`- (Just "This",["is","","a","","test."])+ it "breaks consecutive short texts into chunks" $ do+ intoPieces isSpace "Hello" (Nothing, [])+ `shouldBe` (Just "Hello", [])+ intoPieces isSpace "" (Nothing, [])+ `shouldBe` (Nothing, [])+ intoPieces isSpace "" (Nothing, ["World"])+ `shouldBe` (Nothing, ["World"])+ intoPieces isSpace "This is" (Nothing, ["", "a", "", "test."])+ `shouldBe` (Just "This", ["is", "", "a", "", "test."])+ intoPieces isSpace "This i" (Just "s", ["", "a", "", "test."])+ `shouldBe` (Just "This", ["is", "", "a", "", "test."]) - it "single piece containing multiple words splits correctly" $- let- text = "This is a test"- in do- breakWords text `shouldBe` ["This","is","a","test"]+ it "single piece containing multiple words splits correctly" $+ let text = "This is a test"+ in do+ breakWords text `shouldBe` ["This", "is", "a", "test"] - it "single piece, long run of whitespace splits correctly" $- let- text = "This is\na test"- in do- breakWords text `shouldBe` ["This","is","a","test"]+ it "single piece, long run of whitespace splits correctly" $+ let text = "This is\na test"+ in do+ breakWords text `shouldBe` ["This", "is", "a", "test"] - it "text spanning two pieces can be split into words" $- let- text = "This is " <> "a test"- in do- breakWords text `shouldBe` ["This","is","a","test"]+ it "text spanning two pieces can be split into words" $+ let text = "This is " <> "a test"+ in do+ breakWords text `shouldBe` ["This", "is", "a", "test"] - it "text spanning many pieces can be split into words" $- let- text = "st" <> "" <> "op" <> "" <> " " <> " " <> "and go" <> "op"- in do- breakWords text `shouldBe` ["stop","and","goop"]+ it "text spanning many pieces can be split into words" $+ let text = "st" <> "" <> "op" <> "" <> " " <> " " <> "and go" <> "op"+ in do+ breakWords text `shouldBe` ["stop", "and", "goop"] - it "empty and whitespace-only corner cases handled correctly" $- let- text = " " <> "" <> "stop" <> "" <> " "- in do+ it "empty and whitespace-only corner cases handled correctly" $+ let text = " " <> "" <> "stop" <> "" <> " "+ in do breakWords text `shouldBe` ["stop"] - describe "Splitting into lines" $ do- it "preconditions are met" $ do- breakLines "" `shouldBe` []- breakLines "Hello" `shouldBe` ["Hello"]- breakLines "Hello\nWorld" `shouldBe` ["Hello","World"]- breakLines "Hello\n" `shouldBe` ["Hello"]- breakLines "\nHello" `shouldBe` ["","Hello"]- breakLines "\nHello\n" `shouldBe` ["","Hello"]- breakLines "Hello\nWorld\n" `shouldBe` ["Hello","World"]- breakLines "Hello\n\nWorld\n" `shouldBe` ["Hello","","World"]- breakLines "Hello\n\nWorld\n\n" `shouldBe` ["Hello","","World",""]+ describe "Splitting into lines" $ do+ it "preconditions are met" $ do+ breakLines "" `shouldBe` []+ breakLines "Hello" `shouldBe` ["Hello"]+ breakLines "Hello\nWorld" `shouldBe` ["Hello", "World"]+ breakLines "Hello\n" `shouldBe` ["Hello"]+ breakLines "\nHello" `shouldBe` ["", "Hello"]+ breakLines "\nHello\n" `shouldBe` ["", "Hello"]+ breakLines "Hello\nWorld\n" `shouldBe` ["Hello", "World"]+ breakLines "Hello\n\nWorld\n" `shouldBe` ["Hello", "", "World"]+ breakLines "Hello\n\nWorld\n\n" `shouldBe` ["Hello", "", "World", ""] - it "single piece containing multiple lines splits correctly" $- let- para = [quote|+ it "single piece containing multiple lines splits correctly" $+ let para =+ [quote| This is a test of the Emergency Broadcast System, beeeeep |]- in do- breakLines para `shouldBe`- [ "This is a test"- , "of the Emergency"- , "Broadcast"- , "System, beeeeep"- ]+ in do+ breakLines para+ `shouldBe` [ "This is a test",+ "of the Emergency",+ "Broadcast",+ "System, beeeeep"+ ] - it "preserves blank lines" $- let- para = [quote|+ it "preserves blank lines" $+ let para =+ [quote| First line. Third line. |]- in do- breakLines para `shouldBe`- [ "First line."- , ""- , "Third line."- ]+ in do+ breakLines para+ `shouldBe` [ "First line.",+ "",+ "Third line."+ ] - describe "Formatting paragraphs" $ do- it "multi-line paragraph rewraps correctly" $- let- para = [quote|+ describe "Formatting paragraphs" $ do+ it "multi-line paragraph rewraps correctly" $+ let para =+ [quote| Hello this is a test of the Emergency Broadcast System |]- in- wrap 20 para `shouldBe` [quote|+ in wrap 20 para+ `shouldBe` [quote| Hello this is a test of the Emergency Broadcast System|] - describe "Lines and columns" $ do- it "calculate position of a given block" $ do- calculatePositionEnd "" `shouldBe` (1,1)- calculatePositionEnd "Hello" `shouldBe` (1,6)- calculatePositionEnd "Hello\nWorld" `shouldBe` (2,6)- calculatePositionEnd "\nWorld" `shouldBe` (2,6)- calculatePositionEnd "\n" `shouldBe` (2,1)+ describe "Lines and columns" $ do+ it "calculate position of a given block" $ do+ calculatePositionEnd "" `shouldBe` (1, 1)+ calculatePositionEnd "Hello" `shouldBe` (1, 6)+ calculatePositionEnd "Hello\nWorld" `shouldBe` (2, 6)+ calculatePositionEnd "\nWorld" `shouldBe` (2, 6)+ calculatePositionEnd "\n" `shouldBe` (2, 1)
tests/Everything.hs view
@@ -1,26 +1,26 @@ {-# OPTIONS_HADDOCK not-home, hide #-} -{-|-Meta package re-exporting all the modules in the collection, which is only-here so the top level __unbeliever__ package shows dependencies on-__core-text__, __core-data__, and __core-program__.--} -- -- This module is not exposed. Should it be? At first seems like a nice -- idea, but caused more problems than anything; you try to actually use -- e.g. Rope and you get a "hidden package core-text" errors. --++-- |+-- Meta package re-exporting all the modules in the collection, which is only+-- here so the top level __unbeliever__ package shows dependencies on+-- __core-text__, __core-data__, and __core-program__. module Everything- (- module Core.Text- , module Core.Program- , module Core.Data- , module Core.Encoding- , module Core.System- ) where+ ( module Core.Text,+ module Core.Program,+ module Core.Data,+ module Core.Encoding,+ module Core.System,+ )+where -import Core.Text import Core.Data+import Core.Encoding import Core.Program import Core.System-import Core.Encoding+import Core.Text
tests/TestSuite.hs view
@@ -1,24 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} -import Test.Hspec--import Core.System-import CheckRopeBehaviour (checkRopeBehaviour)+import CheckArgumentsParsing (checkArgumentsParsing) import CheckBytesBehaviour import CheckContainerBehaviour import CheckJsonWrapper-import CheckArgumentsParsing (checkArgumentsParsing) import CheckProgramMonad+import CheckRopeBehaviour (checkRopeBehaviour)+import Core.System+import Test.Hspec main :: IO () main = do- finally (hspec suite) (putStrLn ".")+ finally (hspec suite) (putStrLn ".") suite :: Spec suite = do- checkRopeBehaviour- checkBytesBehaviour- checkContainerBehaviour- checkJsonWrapper- checkArgumentsParsing- checkProgramMonad+ checkRopeBehaviour+ checkBytesBehaviour+ checkContainerBehaviour+ checkJsonWrapper+ checkArgumentsParsing+ checkProgramMonad
unbeliever.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: fedafd1087139044ebc03b568441a99811b05346172ad635378d636638dae29b+-- hash: 5e3f1cd9a1a01a6b20e15c8c6aac38653f20d6cc31203e7b0ad9f2d69ff57116 name: unbeliever-version: 0.10.0.6+version: 0.10.0.7 synopsis: Opinionated Haskell Interoperability description: A library to help build command-line programs, both tools and longer-running daemons. Its @Program@ type provides unified ouptut &@@ -47,7 +47,7 @@ copyright: © 2018-2020 Athae Eredh Siniath and Others license: BSD3 license-file: LICENSE-tested-with: GHC == 8.8.3+tested-with: GHC == 8.8.4 build-type: Simple source-repository head@@ -62,8 +62,8 @@ ghc-options: -Wall -Wwarn -fwarn-tabs build-depends: base >=4.11 && <5- , core-data >=0.2.1.7- , core-program >=0.2.4.4+ , core-data >=0.2.1.8+ , core-program >=0.2.5.0 , core-text >=0.2.3.5 default-language: Haskell2010 @@ -83,15 +83,17 @@ build-depends: base >=4.11 && <5 , bytestring- , core-data >=0.2.1.7- , core-program >=0.2.4.4+ , core-data >=0.2.1.8+ , core-program >=0.2.5.0 , core-text >=0.2.3.5 , fingertree , hashable , hspec+ , prettyprinter , safe-exceptions , text , text-short+ , unordered-containers default-language: Haskell2010 benchmark performance@@ -103,8 +105,8 @@ build-depends: base >=4.11 && <5 , bytestring- , core-data >=0.2.1.7- , core-program >=0.2.4.4+ , core-data >=0.2.1.8+ , core-program >=0.2.5.0 , core-text >=0.2.3.5 , gauge , text