diff --git a/tests/CheckArgumentsParsing.hs b/tests/CheckArgumentsParsing.hs --- 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 + 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 diff --git a/tests/CheckBytesBehaviour.hs b/tests/CheckBytesBehaviour.hs --- 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 --- 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 "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 "&") diff --git a/tests/CheckJsonWrapper.hs b/tests/CheckJsonWrapper.hs --- 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 --- 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 @@ 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 ()) diff --git a/tests/CheckRopeBehaviour.hs b/tests/CheckRopeBehaviour.hs --- 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.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) diff --git a/tests/Everything.hs b/tests/Everything.hs --- 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 --- 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 --- a/unbeliever.cabal +++ b/unbeliever.cabal @@ -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