unbeliever 0.9.2.0 → 0.9.3.2

raw patch · 10 files changed

+304/−150 lines, 10 filesdep −Cabaldep ~hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: Cabal

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• lib/Core/Program/Execute.hs +12/−2
• lib/Core/Program/Logging.hs +4/−4
• lib/Core/Program/Metadata.hs +47/−25
• lib/Core/System/Base.hs +3/−1
• lib/Core/Text/Breaking.hs +147/−0
• lib/Core/Text/Bytes.hs +25/−2
• lib/Core/Text/Rope.hs +9/−2
• lib/Core/Text/Utilities.hs +8/−109
• tests/CheckRopeBehaviour.hs +47/−1
• unbeliever.cabal +2/−4

@@ -68,6 +68,7 @@       , update         {-* Useful actions -}       , output+      , input         {-* Concurrency -}       , Thread       , fork@@ -98,6 +99,7 @@ import qualified Data.ByteString as B (hPut) import qualified Data.ByteString.Char8 as C (singleton) import GHC.Conc (numCapabilities, getNumProcessors, setNumCapabilities)+import GHC.IO.Encoding (setLocaleEncoding, utf8) import System.Exit (ExitCode(..)) import qualified System.Posix.Process as Posix (exitImmediately) @@ -189,6 +191,9 @@     -- command line +RTS -Nn -RTS value     when (numCapabilities == 1) (getNumProcessors >>= setNumCapabilities) +    -- force UTF-8 working around bad VMs+    setLocaleEncoding utf8+     let quit = exitSemaphoreFrom context         level = verbosityLevelFrom context         out = outputChannelFrom context@@ -389,8 +394,13 @@ blob you pass in is other than UTF-8 text). -} output :: Handle -> Bytes -> Program τ ()-output h b = liftIO $ do-        B.hPut h (fromBytes b)+output handle contents = liftIO (hOutput handle contents)++{-|+Read the (entire) contents of the specified @Handle@.+-}+input :: Handle -> Program τ Bytes+input handle = liftIO (hInput handle)  {-| A thread for concurrent computation. Haskell uses green threads: small

@@ -12,9 +12,9 @@ a single purpose, and long-running daemons that effectively run forever.  Tools tend to be run to either have an effect (in which case they tend not-to say much of anything) or to report a result (which is usually printed to-your terminal). This tends to be written to \"standard output\",-traditionally abbreviated in code as @stdout@.+to a say much of anything) or to report a result. This tends to be written+to \"standard output\"—traditionally abbreviated in code as @stdout@—which+is usually printed to your terminal.  Daemons, on the other hand, don't write their output to file descriptor 1; rather they tend to respond to requests by writing to files, replying over@@ -44,7 +44,7 @@ in the invoking shell with @2>&1@, which inevitably results in @stderr@ text appearing in the middle of normal @stdout@ lines corrupting them. -The original idea of standard error was to provde a way to adverse+The original idea of standard error was to provde a way to report adverse conditions without interrupting normal text output, but as we have just observed if it happens without context or out of order there isn't much point. Instead this library offers a mechanism which caters for the

@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveLift #-}+{-# LANGUAGE OverloadedStrings #-}  {-| Dig metadata out of the description of your project.@@ -20,15 +21,13 @@ ) where -import qualified Data.List as List+import Core.Data+import Core.Text+import Core.System (withFile, IOMode(..))+import Data.List (intersperse)+import qualified Data.List as List (isSuffixOf, find)+import Data.Maybe (fromMaybe) import Data.String-import Distribution.Types.GenericPackageDescription (GenericPackageDescription, packageDescription)-import Distribution.Types.PackageDescription (synopsis, package)-import Distribution.Types.PackageId (pkgName, pkgVersion)-import Distribution.Types.PackageName (unPackageName)-import Distribution.PackageDescription.Parsec (readGenericPackageDescription)-import Distribution.Pretty (prettyShow)-import Distribution.Verbosity (normal) import Language.Haskell.TH (Q, runIO) import Language.Haskell.TH.Syntax (Lift, Exp(..)) import System.Directory (listDirectory)@@ -95,20 +94,23 @@     context <- 'Core.Program.Execute.configure' version 'Core.Program.Execute.None' ('Core.Program.Arguments.simple' ... @ -(this wraps the extensive machinery in the __Cabal__ library, notably-'PackageDescription'. Using Template Haskell slows down compilation of this-file, but the upside of this technique is that it avoids linking the-Haskell build machinery into your executable, saving you about 10 MB in the-size of the resultant binary)+(Using Template Haskell slows down compilation of this file, but the upside+of this technique is that it avoids linking the Haskell build machinery+into your executable, saving you about 10 MB in the size of the resultant+binary) -} fromPackage :: Q Exp fromPackage = do-    generic <- readCabalFile-    let desc = packageDescription generic-        version = Version-            { projectNameFrom = unPackageName . pkgName . package $ desc-            , projectSynopsisFrom = synopsis desc-            , versionNumberFrom = prettyShow . pkgVersion . package $ desc+    pairs <- readCabalFile++    let name = fromMaybe "" . lookupKeyValue "name" $ pairs+    let synopsis = fromMaybe "" . lookupKeyValue "synopsis" $ pairs+    let version = fromMaybe "" . lookupKeyValue "version" $ pairs++    let result = Version+            { projectNameFrom = fromRope name+            , projectSynopsisFrom = fromRope synopsis+            , versionNumberFrom = fromRope version             }  --  I would have preferred@@ -118,7 +120,7 @@ -- --  but that's not happening. So more voodoo TH nonsense instead. -    [e|version|]+    [e|result|]   {-@@ -135,15 +137,35 @@         Just file -> return file         Nothing -> error "No .cabal file found" -readCabalFile :: Q GenericPackageDescription+readCabalFile :: Q (Map Rope Rope) readCabalFile = runIO $ do     -- Find .cabal file     file <- findCabalFile-    -    -- Parse .cabal file-    desc <- readGenericPackageDescription normal file +    -- Parse .cabal file+    contents <- withFile file ReadMode hInput+    let pairs = parseCabalFile contents     -- pass to calling program-    return desc+    return pairs +parseCabalFile :: Bytes -> Map Rope Rope+parseCabalFile contents =+  let+    breakup = intoMap . fmap (breakRope (== ':')) . breakLines . fromBytes+  in+    breakup contents +-- this should probably be a function in Core.Text.Rope+breakRope :: (Char -> Bool) -> Rope -> (Rope,Rope)+breakRope predicate text =+  let+    pieces = take 2 (breakPieces predicate text)+  in+    case pieces of+        [] -> ("","")+        [one] -> (one,"")+        (one:two:_) -> (one, trimRope two)++-- knock off the whitespace in "name:      hello"+trimRope :: Rope -> Rope+trimRope = mconcat . intersperse " " . breakWords

@@ -14,6 +14,8 @@       {-** from System.IO -}       {-| Re-exported from "System.IO" in __base__: -}     , Handle+    , IOMode(..)+    , withFile     , stdin, stdout, stderr     , hFlush     , unsafePerformIO@@ -32,6 +34,6 @@ import Control.Exception.Safe (Exception(..), SomeException, throw     , bracket, catch, finally, impureThrow) import Control.Monad.IO.Class (MonadIO, liftIO)-import System.IO (Handle, stdin, stdout, stderr, hFlush)+import System.IO (Handle, IOMode(..), withFile, stdin, stdout, stderr, hFlush) import System.IO.Unsafe (unsafePerformIO) 

@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK hide #-}++-- This is an Internal module, hidden from Haddock+module Core.Text.Breaking+    ( breakWords+    , breakLines+    , breakPieces+    , intoPieces+    , intoChunks+    )+where++import Data.Char (isSpace)+import Data.Foldable (foldr)+import Data.List (uncons)+import qualified Data.Text.Short as S (ShortText, null, break, uncons,empty)++import Core.Text.Rope++{-|+Split a passage of text into a list of words. A line is broken wherever+there is one or more whitespace characters, as defined by "Data.Char"'s+'Data.Char.isSpace'.++Examples:++@+λ> __breakWords \"This is a test\"__+[\"This\",\"is\",\"a\",\"test\"]+λ> __breakWords (\"St\" <> \"op and \" <> \"go left\")__+[\"Stop\",\"and\",\"go\",\"left\"]+λ> __breakWords emptyRope__+[]+@+-}+breakWords :: Rope -> [Rope]+breakWords = filter (not . nullRope) . breakPieces isSpace++{-|+Split a paragraph of text into a list of its individual lines. The+paragraph will be broken wherever there is a @'\n'@ character.++Blank lines will be preserved. Note that as a special case you do /not/ get+a blank entry at the end of the a list of newline terminated strings.++@+λ> __breakLines \"Hello\\n\\nWorld\\n\"__+[\"Hello\",\"\",\"World\"]+@+-}+breakLines :: Rope -> [Rope]+breakLines text =+  let+    result = breakPieces isNewline text+    n = length result - 1+    (fore,aft) = splitAt n result+  in case result of+    [] -> []+    [p] -> [p]+    _ -> if aft == [""]+        then fore+        else result++isNewline :: Char -> Bool+isNewline c = c == '\n'++{-|+Break a Rope into pieces whereever the given predicate function returns+@True@. If found, that character will not be included on either side. Empty+runs, however, *will* be preserved.+-}+breakPieces :: (Char -> Bool) -> Rope -> [Rope]+breakPieces predicate text =+  let+    x = unRope text+    (final,result) = foldr (intoPieces predicate) (Nothing,[]) x+  in+    case final of+       Nothing -> result+       Just piece -> intoRope piece : result++{-+Was the previous piece a match, or are we in the middle of a run of+characters? If we were, then join the previous run to the current piece+before processing into chunks.+-}+-- now for right fold+intoPieces :: (Char -> Bool) -> S.ShortText -> (Maybe S.ShortText,[Rope]) -> (Maybe S.ShortText,[Rope])+intoPieces predicate piece (stream,list) =+  let+    piece' = case stream of+        Nothing -> piece+        Just previous -> piece <> previous       -- more rope, less text?++    pieces = intoChunks predicate piece'+  in+    case uncons pieces of+        Nothing -> (Nothing,list)+        Just (text,remainder) -> (Just (fromRope text),remainder ++ list)++--+-- λ> S.break isSpace "a d"+-- ("a"," d")+--+-- λ> S.break isSpace " and"+-- (""," and")+--+-- λ> S.break isSpace "and "+-- ("and"," ")+--+-- λ> S.break isSpace ""+-- ("","")+--+-- λ> S.break isSpace " "+-- (""," ")+--++{-+This was more easily expressed as ++  let+    remainder' = S.drop 1 remainder+  in+    if remainder == " "++for the case when we were breaking on spaces. But generalized to a predicate+we have to strip off the leading character and test that its the only character;+this is cheaper than S.length etc.+-}+intoChunks :: (Char -> Bool) -> S.ShortText -> [Rope]+intoChunks _ piece | S.null piece = []+intoChunks predicate piece =+  let+    (chunk,remainder) = S.break predicate piece++    -- Handle the special case that a trailing " " (generalized to predicate)+    -- is the only character left.+    (trailing,remainder') = case S.uncons remainder of+        Nothing -> (False,S.empty)+        Just (c,remaining) -> if S.null remaining+            then (predicate c,S.empty)+            else (False,remaining)+  in+    if trailing+        then intoRope chunk : emptyRope : []+        else intoRope chunk : intoChunks predicate remainder'

@@ -30,13 +30,14 @@     ( Bytes     , Binary(fromBytes, intoBytes)     , hOutput+    , hInput     , chunk     ) where  import Data.Bits (Bits (..)) import Data.Char (intToDigit) import qualified Data.ByteString as B (ByteString, foldl', splitAt-    , pack, unpack, length, hPut)+    , pack, unpack, length, hPut, hGetContents) import Data.ByteString.Internal (c2w, w2c) import qualified Data.ByteString.Lazy as L (ByteString, fromStrict, toStrict) import Data.Hashable (Hashable)@@ -52,6 +53,7 @@     color, colorDull, bold, Color(..)) import System.IO (Handle) +import Core.Text.Rope import Core.Text.Utilities  {-|@@ -93,6 +95,10 @@     fromBytes (StrictBytes b') = B.unpack b'     intoBytes = StrictBytes . B.pack +instance Binary Rope where+    fromBytes (StrictBytes b') = intoRope b'+    intoBytes = StrictBytes . fromRope+ {-| Output the content of the 'Bytes' to the specified 'Handle'. @@ -109,7 +115,7 @@ the ordering of output on the user's terminal. Instead do:  @-    write (intoRope b)+    'Core.Program.Execute.write' ('intoRope' b) @  on the assumption that the bytes in question are UTF-8 (or plain ASCII)@@ -117,6 +123,23 @@ -} hOutput :: Handle -> Bytes -> IO () hOutput handle (StrictBytes b') = B.hPut handle b'++{-|+Read the (entire) contents of a handle into a Bytes object.++If you want to read the entire contents of a file, you can do:++@+    contents <- 'Core.System.Base.withFile' name 'Core.System.Base.ReadMode' 'hInput'+@++At any kind of scale, Streaming I/O is almost always for better, but for+small files you need to pick apart this is fine.+-}+hInput :: Handle -> IO Bytes+hInput handle = do+   contents <- B.hGetContents handle+   return (StrictBytes contents)  -- (), aka Unit, aka **1**, aka something with only one inhabitant 

@@ -84,6 +84,7 @@     , hWrite       {-* Internals -}     , unRope+    , nullRope     , unsafeIntoRope     , Width(..)     ) where@@ -95,7 +96,8 @@ import qualified Data.ByteString.Lazy as L (ByteString, toStrict     , foldrChunks) import qualified Data.FingerTree as F (FingerTree, Measured(..), empty-    , singleton, (><), (<|), (|>), search, SearchResult(..), null)+    , singleton, (><), (<|), (|>), search, SearchResult(..), null+    , viewl, ViewL(..)) import Data.Foldable (foldr, foldr', foldMap, toList, any) import Data.Hashable (Hashable, hashWithSalt) import Data.String (IsString(..))@@ -105,7 +107,7 @@ import qualified Data.Text.Lazy.Builder as U (Builder, toLazyText     , fromText) import Data.Text.Prettyprint.Doc (Pretty(..), emptyDoc)-import qualified Data.Text.Short as S (ShortText, length, any+import qualified Data.Text.Short as S (ShortText, length, any, null     , fromText, toText, fromByteString, pack, unpack     , append, empty, toBuilder, splitAt) import qualified Data.Text.Short.Unsafe as S (fromByteStringUnsafe)@@ -235,6 +237,11 @@ widthRope = foldr' f 0 . unRope   where     f piece count = S.length piece + count++nullRope :: Rope -> Bool+nullRope (Rope x) = case F.viewl x of+    F.EmptyL        -> True+    (F.:<) piece _  -> S.null piece  {-| Break the text into two pieces at the specified offset.

@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK prune #-}  {-| Useful tools for working with 'Rope's. Support for pretty printing,@@ -23,15 +24,17 @@     , underline       {-* Multi-line strings -}     , quote++    -- for testing+    , intoPieces+    , intoChunks ) where -import Data.Char (isSpace)-import qualified Data.FingerTree as F ((<|), ViewL(..), viewl, singleton)+import qualified Data.FingerTree as F ((<|), ViewL(..), viewl) import qualified Data.List as List (foldl', dropWhileEnd) import Data.Monoid ((<>)) import qualified Data.Text as T-import qualified Data.Text.Short as S (ShortText, uncons, toText, empty-    , null, breakEnd, append, dropEnd)+import qualified Data.Text.Short as S (ShortText, uncons, toText) import Data.Text.Prettyprint.Doc (Doc, layoutPretty , reAnnotateS     , pretty, emptyDoc     , LayoutOptions(LayoutOptions)@@ -41,6 +44,7 @@ import Language.Haskell.TH.Quote (QuasiQuoter(QuasiQuoter))  import Core.Text.Rope+import Core.Text.Breaking  -- change AnsiStyle to a custom token type, perhaps Ansi, which -- has the escape codes already converted to Rope.@@ -141,111 +145,6 @@             Just (c,_)  -> if c `elem` ['A','E','I','O','U','a','e','i','o','u']                 then intoRope ("an " F.<| x)                 else intoRope ("a " F.<| x)--{-|-Split a passage of text into a list of words. A line is broken wherever-there is one or more whitespace characters, as defined by "Data.Char"'s-'Data.Char.isSpace'.--Examples:--@-λ> __breakWords \"This is a test\"__-[\"This\",\"is\",\"a\",\"test\"]-λ> __breakWords (\"St\" <> \"op and \" <> \"go left\")__-[\"Stop\",\"and\",\"go\",\"left\"]-λ> __breakWords emptyRope__-[]-@--}-breakWords :: Rope -> [Rope]-breakWords text = breakPieces isSpace text--{-|-Split a paragraph of text into a list of its individual lines. The-paragraph will be broken wherever there is a @'\n'@ character.--}-breakLines :: Rope -> [Rope]-breakLines text = breakPieces isNewline text--isNewline :: Char -> Bool-isNewline c = c == '\n'--{-|-Break a Rope into pieces whereever the given predicate function returns-@True@. If found, that character will not be included on either side.--}-breakPieces :: (Char -> Bool) -> Rope -> [Rope]-breakPieces predicate text =-  let-    (final,list) = foldr (finder predicate) (S.empty,[]) (unRope text)-    l = intoRope (F.singleton final)-  in-    if S.null final-        then list-        else l:list--finder-    :: (Char -> Bool)-    -> S.ShortText-    -> (S.ShortText,[Rope])-    -> (S.ShortText,[Rope])-finder predicate piece (accum,list) =-  let-    done = S.null piece--    -- λ> S.breakEnd isSpace "a d"-    -- ("a","d")-    ---    -- λ> S.breakEnd isSpace " and"-    -- (" ","and")-    ---    -- λ> S.breakEnd isSpace "and "-    -- ("and ","")-    ---    -- λ> S.breakEnd isSpace ""-    -- ("","")-    ---    -- λ> S.breakEnd isSpace " "-    -- (" ","")--    (remainder,fragment) = S.breakEnd predicate piece--    -- Are we in the middle of a word? We are if the carry forward is-    -- non-zero length.-    ---    -- Did we find a word in the current piece? If so, then if we are in-    -- the middle of accumulating a word, we add the new piece to it.--    found  = not (S.null fragment)-    middle = not (S.null accum)--    accum' = if found-                then if middle-                    then S.append fragment accum-                    else fragment-                else accum--    -- Did we find a space? We did if remainder is non-zero length.-    -- Finding a space means flushing out the accumulator (though only if-    -- there's actually something there). We have to drop that whitespace-    -- before iterating.--    space = not (S.null remainder)-    empty = S.null accum'-    word = intoRope accum'--    list' = if empty-                then list-                else word:list--    remainder' = S.dropEnd 1 remainder-  in-    if done-        then (accum',list)-        else if space-            then finder predicate remainder' (S.empty,list')-            else finder predicate remainder (accum',list)  {-| Often the input text represents a paragraph, but does not have any internal

@@ -4,6 +4,7 @@  module CheckRopeBehaviour where +import Data.Char (isSpace) import qualified Data.FingerTree as F import qualified Data.List as List import qualified Data.Text as T@@ -111,6 +112,26 @@             |] `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"@@ -135,13 +156,24 @@           in do             breakWords text `shouldBe` ["stop","and","goop"] -        it "empty and whitespace-only corner cases handled correctly " $+        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|@@ -156,6 +188,20 @@                 , "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

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: unbeliever-version: 0.9.2.0+version: 0.9.3.2 license: BSD3 license-file: LICENCE copyright: © 2018-2019 Operational Dynamics Consulting Pty Ltd, and Others@@ -50,12 +50,12 @@         Core.System.External     hs-source-dirs: lib     other-modules:+        Core.Text.Breaking         Core.Program.Context         Core.Program.Signal     default-language: Haskell2010     ghc-options: -Wall -Wwarn -fwarn-tabs     build-depends:-        Cabal >=2.4.1.0 && <2.5,         aeson >=1.4.2.0 && <1.5,         async >=2.2.1 && <2.3,         base >=4.11 && <5,@@ -97,7 +97,6 @@     default-language: Haskell2010     ghc-options: -Wall -Wwarn -fwarn-tabs -threaded     build-depends:-        Cabal >=2.4.1.0 && <2.5,         aeson >=1.4.2.0 && <1.5,         async >=2.2.1 && <2.3,         base >=4.11 && <5,@@ -134,7 +133,6 @@     default-language: Haskell2010     ghc-options: -Wall -Wwarn -fwarn-tabs -threaded     build-depends:-        Cabal >=2.4.1.0 && <2.5,         aeson >=1.4.2.0 && <1.5,         async >=2.2.1 && <2.3,         base >=4.11 && <5,