summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrewCowie <>2020-10-17 22:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-17 22:46:00 (GMT)
commitb0b913d036ba48dc835a0b45245381de6bc7dfc4 (patch)
tree80b84fdb8151e42023f417284373f10469799980
parentcc311ecd1e5c04d7ebb8e8415bbc422b8593c347 (diff)
version 0.10.0.70.10.0.7
-rw-r--r--tests/CheckArgumentsParsing.hs284
-rw-r--r--tests/CheckBytesBehaviour.hs22
-rw-r--r--tests/CheckContainerBehaviour.hs90
-rw-r--r--tests/CheckJsonWrapper.hs54
-rw-r--r--tests/CheckProgramMonad.hs123
-rw-r--r--tests/CheckRopeBehaviour.hs400
-rw-r--r--tests/Everything.hs28
-rw-r--r--tests/TestSuite.hs23
-rw-r--r--unbeliever.cabal20
9 files changed, 514 insertions, 530 deletions
diff --git a/tests/CheckArgumentsParsing.hs b/tests/CheckArgumentsParsing.hs
index 4c17e82..6815ea3 100644
--- a/tests/CheckArgumentsParsing.hs
+++ b/tests/CheckArgumentsParsing.hs
@@ -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
-
- it "recognizes required arguments" $
- let
- config = simple options2
- actual = parseCommandLine config ["hello.txt"]
- expect = Parameters Nothing
+ 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
[ ("filename", Value "hello.txt")
- ] []
- in
- actual `shouldBe` Right expect
-
- it "handles valued parameter" $
- let
- config = simple options2
- actual = parseCommandLine config ["hello.txt"]
- expect = Parameters Nothing
+ ]
+ []
+ in actual `shouldBe` Right expect
+
+ 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")
-
- it "accepts request for version" $
- let
- config = simple options1
- actual = parseCommandLine config ["--version"]
- in
- actual `shouldBe` Left VersionRequest
-
-
- 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 "fails on missing command" $
- let
- config = complex commands1
- actual = parseCommandLine config []
- in
- actual `shouldBe` Left (NoCommandFound)
-
- it "rejects an unknown command" $
- let
- config = complex commands1
- actual = parseCommandLine config ["launch"]
- in
- actual `shouldBe` Left (UnknownCommand "launch")
-
- 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 further trailing arguments" $
- let
- config = complex commands2
- actual = parseCommandLine config ["commit", "some"]
- in
- actual `shouldBe` Left (UnexpectedArguments ["some"])
-
--- 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
-
+ ]
+ []
+ 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")
+
+ it "accepts request for version" $
+ let config = simple options1
+ actual = parseCommandLine config ["--version"]
+ in actual `shouldBe` Left VersionRequest
+
+ 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 "fails on missing command" $
+ let config = complex commands1
+ actual = parseCommandLine config []
+ in actual `shouldBe` Left (NoCommandFound)
+
+ it "rejects an unknown command" $
+ let config = complex commands1
+ actual = parseCommandLine config ["launch"]
+ in actual `shouldBe` Left (UnknownCommand "launch")
+
+ 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 further trailing arguments" $
+ let config = complex commands2
+ actual = parseCommandLine config ["commit", "some"]
+ in actual `shouldBe` Left (UnexpectedArguments ["some"])
+
+ -- 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
diff --git a/tests/CheckBytesBehaviour.hs b/tests/CheckBytesBehaviour.hs
index b652d09..4f07390 100644
--- a/tests/CheckBytesBehaviour.hs
+++ b/tests/CheckBytesBehaviour.hs
@@ -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
diff --git a/tests/CheckContainerBehaviour.hs b/tests/CheckContainerBehaviour.hs
index aa272a6..0a9c100 100644
--- a/tests/CheckContainerBehaviour.hs
+++ b/tests/CheckContainerBehaviour.hs
@@ -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 "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 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 "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 "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 "&")
-
+ 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 "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 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 "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 "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 "&")
diff --git a/tests/CheckJsonWrapper.hs b/tests/CheckJsonWrapper.hs
index d0c9e11..dbb8d5f 100644
--- a/tests/CheckJsonWrapper.hs
+++ b/tests/CheckJsonWrapper.hs
@@ -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
diff --git a/tests/CheckProgramMonad.hs b/tests/CheckProgramMonad.hs
index 006ba30..20859f6 100644
--- a/tests/CheckProgramMonad.hs
+++ b/tests/CheckProgramMonad.hs
@@ -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 @@ boom = const True
checkProgramMonad :: Spec
checkProgramMonad = do
- 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
-
- 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
-
- 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
-
- -- 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 ())
+ 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
+
+ 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
+
+ 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
+
+ -- 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 ())
diff --git a/tests/CheckRopeBehaviour.hs b/tests/CheckRopeBehaviour.hs
index 6ed5d7b..9763da9 100644
--- a/tests/CheckRopeBehaviour.hs
+++ b/tests/CheckRopeBehaviour.hs
@@ -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.Lazy as U
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 @@ compound = "3" <> "-" <> "ethyl" <> "-" <> "4" <> "-" <> "methyl" <> "hexane" ::
checkRopeBehaviour :: Spec
checkRopeBehaviour = do
- 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 "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 "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)
-
- 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 "exports to ByteString" $
- let
- expected = T.encodeUtf8 (T.pack "H₂SO₄")
- in do
+ 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 "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 "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)
+
+ 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 "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 (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")
-
- -- 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")
-
- 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)
-
- 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 "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 "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")
+
+ -- 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 "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)
+
+ 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)
-
- 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 "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 "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 "empty and whitespace-only corner cases handled correctly" $
- let
- text = " " <> "" <> "stop" <> "" <> " "
- in do
+ |]
+ `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", ""]
+
+ 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, 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 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
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",""]
-
- it "single piece containing multiple lines splits correctly" $
- let
- para = [quote|
+ 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|
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|
+ in do
+ breakLines para
+ `shouldBe` [ "This is a test",
+ "of the Emergency",
+ "Broadcast",
+ "System, beeeeep"
+ ]
+
+ it "preserves blank lines" $
+ let para =
+ [quote|
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|
+ in do
+ breakLines para
+ `shouldBe` [ "First line.",
+ "",
+ "Third line."
+ ]
+
+ 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)
diff --git a/tests/Everything.hs b/tests/Everything.hs
index 2afb330..40137e3 100644
--- a/tests/Everything.hs
+++ b/tests/Everything.hs
@@ -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
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
index 8ee3b64..4ba651c 100644
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -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
diff --git a/unbeliever.cabal b/unbeliever.cabal
index 26cc743..a2671bd 100644
--- a/unbeliever.cabal
+++ b/unbeliever.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- 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 @@ maintainer: Andrew Cowie <istathar@gmail.com>
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 @@ library
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 @@ test-suite check
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 @@ benchmark performance
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