yi-rope 0.7.0.2 → 0.11
raw patch · 4 files changed
Files
- bench/MainBenchmarkSuite.hs +2/−1
- src/Yi/Rope.hs +62/−119
- test/Yi/RopeSpec.hs +10/−1
- yi-rope.cabal +11/−17
bench/MainBenchmarkSuite.hs view
@@ -84,7 +84,7 @@ mkTexts x t = (x, F.fromText' x t) allTexts :: [(Int -> String, [(Int, F.YiString)])]-allTexts = [longTexts {-, wideTexts, shortTexts, tinyTexts -}]+allTexts = [longTexts, wideTexts, shortTexts, tinyTexts] allChars :: [(Int -> String, [(Int, Char)])] allChars = map mkChar "λa"@@ -160,6 +160,7 @@ , onCharGroup "singleton" F.singleton , onTextGroup "countNewLines" F.countNewLines , onTextGroup "lines" F.lines+ , onTextGroup "lines'" F.lines' , onSplitGroup "splitAt" F.splitAt , onSplitGroup "splitAtLine" F.splitAtLine , onTextGroup "toReverseString" F.toReverseString
src/Yi/Rope.hs view
@@ -1,8 +1,12 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}+{-# language CPP #-}+{-# language BangPatterns #-}+{-# language DeriveDataTypeable #-}+{-# language LambdaCase #-}+{-# language MultiParamTypeClasses #-}+{-# language OverloadedStrings #-}+{-# language ScopedTypeVariables #-}+{-# language ViewPatterns #-}+{-# options_haddock show-extensions #-} -- | -- Module : Yi.Rope@@ -51,8 +55,7 @@ Yi.Rope.replicate, Yi.Rope.replicateChar, -- * IO- ConverterName, unCn, Yi.Rope.readFile, Yi.Rope.writeFile,- Yi.Rope.writeFileUsingText, Yi.Rope.writeFileWithConverter,+ Yi.Rope.readFile, Yi.Rope.writeFile, -- * Escape latches to underlying content. Note that these are safe -- to use but it does not mean they should.@@ -60,15 +63,11 @@ ) where --import Codec.Text.Detect (detectEncodingName)-import Control.Applicative ((<$>)) import Control.DeepSeq+import Control.Exception (try) import Data.Binary-import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.Char (isSpace)-import Data.Default import qualified Data.FingerTree as T import Data.FingerTree hiding (null, empty, reverse, split) import qualified Data.List as L (foldl')@@ -76,9 +75,10 @@ import Data.Monoid import Data.String (IsString(..)) import qualified Data.Text as TX-import qualified Data.Text.Encoding as TXE-import Data.Text.ICU.Convert-import qualified Data.Text.IO as TF (writeFile)+import qualified Data.Text.Encoding.Error as TXEE+import qualified Data.Text.Lazy as TXL+import qualified Data.Text.Lazy.Encoding as TXLE+import qualified Data.Text.IO as TXIO (writeFile) import Data.Typeable import Prelude hiding (drop) @@ -116,6 +116,11 @@ countNl :: TX.Text -> Int countNl = TX.count "\n" +#if __GLASGOW_HASKELL__ >= 804+instance Semigroup Size where+ (<>) = mappend+#endif+ instance Monoid Size where mempty = Indices 0 0 Indices c l `mappend` Indices c' l' = Indices (c + c') (l + l')@@ -123,7 +128,7 @@ instance Measured Size YiChunk where measure (Chunk l t) = Indices l (countNl t) --- | A 'YiString' is a 'FingerTree' with cached column and line counts+-- | A 'YiString' is a 'FingerTree' with cached char and line counts -- over chunks of 'TX.Text'. newtype YiString = YiString { fromRope :: FingerTree Size YiChunk } deriving (Show, Typeable)@@ -154,6 +159,11 @@ instance IsString YiString where fromString = Yi.Rope.fromString +#if __GLASGOW_HASKELL__ >= 804+instance Semigroup YiString where+ (<>) = mappend+#endif+ instance Monoid YiString where mempty = Yi.Rope.empty mappend = Yi.Rope.append@@ -162,9 +172,6 @@ instance Ord YiString where compare x y = toText x `compare` toText y -instance Default YiString where- def = mempty- (-|) :: YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk b -| t | chunkSize b == 0 = t | otherwise = b <| t@@ -239,6 +246,9 @@ fromText :: TX.Text -> YiString fromText = fromText' defaultChunkSize +fromLazyText :: TXL.Text -> YiString+fromLazyText = YiString . T.fromList . fmap (mkChunk TX.length) . TXL.toChunks+ -- | Consider whether you really need to use this! toText :: YiString -> TX.Text toText = TX.concat . go . fromRope@@ -364,12 +374,12 @@ -- | Takes the first n given characters. take :: Int -> YiString -> YiString-take 1 = maybe def Yi.Rope.singleton . Yi.Rope.head+take 1 = maybe mempty Yi.Rope.singleton . Yi.Rope.head take n = fst . Yi.Rope.splitAt n -- | Drops the first n characters. drop :: Int -> YiString -> YiString-drop 1 = fromMaybe def . Yi.Rope.tail+drop 1 = fromMaybe mempty . Yi.Rope.tail drop n = snd . Yi.Rope.splitAt n -- | The usual 'Prelude.dropWhile' optimised for 'YiString's.@@ -476,10 +486,10 @@ -- pre-process the list. intercalate :: YiString -> [YiString] -> YiString intercalate _ [] = mempty-intercalate (YiString t') (YiString s:ss) = YiString $ s >< go ss+intercalate (YiString t') (YiString s:ss) = YiString $ go s ss where- go [] = mempty- go (YiString t : ts') = t' >< t >< go ts'+ go !acc [] = acc+ go acc (YiString t : ts') = go (acc >< t' >< t) ts' -- | Intersperses the given character between the 'YiString's. This is -- useful when you have a bunch of strings you just want to separate@@ -496,30 +506,24 @@ -- and use 'TX.intersperse' for that instead. intersperse :: Char -> [YiString] -> YiString intersperse _ [] = mempty-intersperse c (t:ts) = t <> go ts+intersperse c (t:ts) = go t ts where- go [] = mempty- go (t':ts') = (c `cons` t') <> go ts'+ go !acc [] = acc+ go acc (t':ts') = go (acc <> (c `cons` t')) ts' -- | Add a 'Char' in front of a 'YiString'.------ We add the character to the front of the first chunk. This does--- mean that a lot of 'cons' might result in an abnormally large first--- chunk so if you have to do that, consider using 'append' instead.. cons :: Char -> YiString -> YiString cons c (YiString t) = case viewl t of EmptyL -> Yi.Rope.singleton c- Chunk !l x :< ts -> YiString $ Chunk (l + 1) (c `TX.cons` x) <| ts+ Chunk l x :< ts | l < defaultChunkSize -> YiString $ Chunk (l + 1) (c `TX.cons` x) <| ts+ _ -> YiString $ Chunk 1 (TX.singleton c) <| t -- | Add a 'Char' in the back of a 'YiString'.------ We add the character to the end of the last chunk. This does mean--- that a lot of 'snoc' might result in an abnormally large last chunk--- so if you have to do that, consider using 'append' instead.. snoc :: YiString -> Char -> YiString snoc (YiString t) c = case viewr t of EmptyR -> Yi.Rope.singleton c- ts :> Chunk l x -> YiString $ ts |> Chunk (l + 1) (x `TX.snoc` c)+ ts :> Chunk l x | l < defaultChunkSize -> YiString $ ts |> Chunk (l + 1) (x `TX.snoc` c)+ _ -> YiString $ t |> Chunk 1 (TX.singleton c) -- | Single character 'YiString'. Consider whether it's worth creating -- this, maybe you can use 'cons' or 'snoc' instead?@@ -638,8 +642,8 @@ all p = go . fromRope where go x = case viewl x of- EmptyL -> False- Chunk _ t :< ts -> TX.all p t || go ts+ EmptyL -> True+ Chunk _ t :< ts -> TX.all p t && go ts -- | To serialise a 'YiString', we turn it into a regular 'String' -- first.@@ -647,60 +651,11 @@ put = put . toString get = Yi.Rope.fromString <$> get --- | 'ConverterName' is used to convey information about the--- underlying 'Converter' used within the buffer to encode and decode--- text. It is mostly here due to the lack of 'Binary' instance for--- 'Converter' itself.-newtype ConverterName = CN String deriving (Show, Eq, Ord, Read, Typeable)---- | Returns the underlying string.-unCn :: ConverterName -> String-unCn (CN s) = s---- | Simply 'put's/'get's the underlying 'String'.-instance Binary ConverterName where- put (CN s) = put s- get = CN <$> get---- | Writes the given 'YiString' to the given file, according to the--- 'Converter' specified by 'ConverterName'. You can obtain a--- 'ConverterName' through 'readFile'. If you have a 'Converter', use--- 'writeFileWithConverter' instead.------ If you don't care about the encoding used such as when creating a--- brand new file, you can use 'writeFileUsingText'.------ It's up to the user to handle exceptions.------ Returns an error message if conversion failed, otherwise Nothing--- on success.-writeFile :: FilePath -> YiString -> ConverterName -> IO (Maybe TX.Text)-writeFile f s (CN cn) = open cn (Just True) >>= writeFileWithConverter f s---- | As 'writeFile' but using the provided 'Converter' rather than--- creating one from a 'ConverterName'.------ It's up to the user to handle exceptions.-writeFileWithConverter :: FilePath -> YiString -> Converter -> IO (Maybe TX.Text)-writeFileWithConverter f s c = do- let bytes = fromUnicode c $ toText s- errorMsg = "Could not encode text with specified encoding"- enc <- detectEncoding errorMsg $ BSL.fromChunks [bytes]- case enc of- Left err -> return $ Just err- Right (_, (CN cn)) -> do- if cn == getName c- then BS.writeFile f bytes >> return Nothing- else return . Just $ errorMsg---- | Write a 'YiString' into the given file. This function uses--- 'TF.writeFile' to do the writing: if you have special needs for--- preserving encoding/decoding, use 'writeFile' instead.+-- | Write a 'YiString' into the given file. -- -- It's up to the user to handle exceptions.-writeFileUsingText :: FilePath -> YiString -> IO ()-writeFileUsingText f = TF.writeFile f . toText-+writeFile :: FilePath -> YiString -> IO ()+writeFile f = TXIO.writeFile f . toText -- | Reads file into the rope, also returning the 'ConverterName' that -- was used for decoding. You should resupply this to 'writeFile' if@@ -711,34 +666,22 @@ -- -- It is up to the user to handle exceptions not directly related to -- character decoding.-readFile :: FilePath -> IO (Either TX.Text (YiString, ConverterName))-readFile fp = BSL.readFile fp >>= detectEncoding err- where err = "Could not guess the encoding of " <> TX.pack fp---- | Detects the encoding of a sequence of bytes.------ Presumably the calculating the 'YiString' is lazy so it is fine--- to use this to only get the converter name.------ Also allows specification of the error to return if the encoding--- of the bytes cannot be detected. The error returns won't necessarily--- be this error - it is used only if no encoding name is detected at all.-detectEncoding :: TX.Text -> BSL.ByteString- -> IO (Either TX.Text (YiString, ConverterName))-detectEncoding err cs =- case detectEncodingName cs of- Nothing -> return $ case TXE.decodeUtf8' $ BSL.toStrict cs of- -- The detection failed but stay optimistic and try as UTF8 anyway.- Left _ -> Left err- Right tx -> Right (fromText tx, CN "UTF-8")- Just enc -> do- let ke = if enc == "ASCII" then Just "UTF-8" else listToMaybe $ aliases enc- case ke of- Nothing -> return . Left . TX.pack $ "Don't know how to decode as " <> enc- Just s -> do- c <- open s (Just True)- let st = BSL.toStrict cs- return $ Right (fromText $ toUnicode c st, CN $ getName c)+readFile :: FilePath -> IO (Either TX.Text YiString)+readFile fp = BSL.readFile fp >>= go decoders+ where+ go [] _ = pure (Left err)+ go (d : ds) bytes =+ try (pure (d bytes)) >>= \case+ Left (_ :: TXEE.UnicodeException) -> go ds bytes+ Right text -> pure (Right (fromLazyText text))+ err = "Could not guess the encoding of " <> TX.pack fp+ decoders =+ [ TXLE.decodeUtf8+ , TXLE.decodeUtf16LE+ , TXLE.decodeUtf16BE+ , TXLE.decodeUtf32LE+ , TXLE.decodeUtf32BE+ ] -- | Filters the characters from the underlying string. --
test/Yi/RopeSpec.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Yi.RopeSpec (main, spec) where -import Control.Applicative import Data.Char (isUpper, toUpper, isSpace) import qualified Data.Text as T import Test.Hspec@@ -38,6 +37,8 @@ prop "R.length ~ T.length" $ R.length `isLike` T.length prop "R.null ~ T.null" $ R.null `isLike` T.null prop "R.countNewLines ~ T.count \\n" $ R.countNewLines `isLike` T.count "\n"+ prop "R.concat . R.lines' = id" $ (R.toText . R.concat . R.lines') `isLike` id+ prop "R.lines ~ T.lines" $ (fmap R.toText . R.lines) `isLike` T.lines prop "R.empty ~ T.empty" $ R.toText R.empty `shouldBe` T.empty prop "fst . R.splitAt ~ fst . T.splitAt" $ \i -> fst . R.splitAt i `isLikeT` fst . T.splitAt i@@ -61,6 +62,10 @@ R.any (const True) (R.fromText t) `shouldBe` T.any (const True) t prop "\\p -> R.any p ~ T.any p $ const False" $ \t -> R.any (const False) (R.fromText t) `shouldBe` T.any (const False) t+ prop "\\p c -> R.any (== c) p ~ T.any (== c) p" $ \c t ->+ R.any (== c) (R.fromText t) `shouldBe` T.any (== c) t+ prop "\\p c -> R.all (== c) p ~ T.all (== c) p" $ \c t ->+ R.all (== c) (R.fromText t) `shouldBe` T.all (== c) t prop "\\f -> R.withText ~ f $ T.toTitle" $ R.withText T.toTitle `isLikeT` T.toTitle prop "\\p -> R.dropWhile p ~ T.dropWhile p $ isUpper" $@@ -104,3 +109,7 @@ prop "R.intercalate ~ T.intercalate" $ \t ts -> R.toText (R.intercalate (R.fromText t) (R.fromText <$> ts)) `shouldBe` T.intercalate t ts+ describe "But R.intersperse is not like T.intersperse" $ do+ prop "R.intercalate (R.singleton c) = R.intersperse c" $ \c ts ->+ let rs = R.fromText <$> ts+ in R.intercalate (R.singleton c) rs `shouldBe` R.intersperse c rs
yi-rope.cabal view
@@ -1,34 +1,28 @@ name: yi-rope-version: 0.7.0.2+version: 0.11 synopsis: A rope data structure used by Yi description: A rope data structure used by Yi license: GPL-2 license-file: LICENSE-author: Mateusz Kowalczyk-maintainer: fuuzetsu@fuuzetsu.co.uk+author: AUTHORS+maintainer: yi-devel@googlegroups.com category: Yi build-type: Simple cabal-version: >=1.10 library- if true- ghc-options: -fpedantic-bottoms -fexpose-all-unfoldings -Wall -O2- if impl(ghc >= 7.8.1)- ghc-options: -flate-dmd-anal+ ghc-options: -fpedantic-bottoms -fexpose-all-unfoldings -ferror-spans -Wall -O2 -flate-dmd-anal exposed-modules: Yi.Rope build-depends:- base >=4.5 && <5+ base >=4.8 && <5 , binary- , bytestring- , charsetdetect-ae >= 1.0.1- , data-default+ , bytestring >= 0.10 , deepseq- , fingertree- , text- , text-icu+ , fingertree >= 0.1.1+ , text >= 1.2 hs-source-dirs: src default-language: Haskell2010@@ -38,7 +32,7 @@ default-language: Haskell2010 main-is: Spec.hs hs-source-dirs: test- ghc-options: -funbox-strict-fields -Wall -O2+ ghc-options: -Wall -O2 -rtsopts other-modules: Yi.RopeSpec @@ -55,10 +49,10 @@ default-language: Haskell2010 main-is: MainBenchmarkSuite.hs hs-source-dirs: bench- ghc-options: -funbox-strict-fields -Wall -O2+ ghc-options: -Wall -O2 build-depends:- base >=4.5 && <5+ base >=4.8 && <5 , criterion , deepseq , text