diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Andrey Mulik (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Andrey Mulik nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/sdp4text.cabal b/sdp4text.cabal new file mode 100644 --- /dev/null +++ b/sdp4text.cabal @@ -0,0 +1,100 @@ +name: sdp4text +version: 0.2 +category: Data Structures + +synopsis: SDP wrapper for Text. +description: This package implements SDP classes for Text. + +author: Andrey Mulik +maintainer: work.a.mulik@gmail.com +bug-reports: https://github.com/andreymulik/sdp4text/issues + +copyright: 2020 Andrey Mulik +license-file: LICENSE +license: BSD3 + +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/andreymulik/sdp4text + +--- _ _____ ______ ______ ___ ______ __ __ --- +--- | | |_ _|| ___ \| ___ \ / _ \ | ___ \\ \ / / --- +--- | | | | | |_/ /| |_/ // /_\ \| |_/ / \ V / --- +--- | | | | | ___ \| / | _ || / \ / --- +--- | |____ _| |_ | |_/ /| |\ \ | | | || |\ \ | | --- +--- \_____/ \___/ \____/ \_| \_|\_| |_/\_| \_| \_/ --- + +Library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -Wno-orphans -Wcompat + + build-depends: + base >= 4.12 && < 5, + text >= 1.2 && < 1.3, + sdp >= 0.2 && < 0.3, + sdp-io >= 0.2 && < 0.3 + + exposed-modules: + SDP.Text.Builder + SDP.Text.Lazy + SDP.Text + +--- _____ _____ _____ _____ _____ _ _ _____ --- +--- |_ _|| ___|/ ___||_ _||_ _|| \ | || __ \ --- +--- | | | |__ \ `--. | | | | | \| || | \/ --- +--- | | | __| `--. \ | | | | | . ` || | __ --- +--- | | | |___ /\__/ / | | _| |_ | |\ || |_\ \ --- +--- \_/ \____/ \____/ \_/ \___/ \_| \_/ \____/ --- + +test-suite test-bytestring-strict + default-language: Haskell2010 + hs-source-dirs: test, src + + type: exitcode-stdio-1.0 + main-is: test-text-strict.hs + ghc-options: -Wall -Wno-orphans + other-modules: + SDP.Text + + build-depends: + base >= 4.12 && < 5, + sdp >= 0.2 && < 0.3, + text >= 1.2 && < 1.3, + sdp-io >= 0.2 && < 0.3, + + QuickCheck >= 2.12 && < 3, + sdp-quickcheck >= 0.2 && < 0.3, + quickcheck-instances >= 0.3 && < 0.4, + + test-framework >= 0.8 && < 0.9, + test-framework-quickcheck2 >= 0.3 && < 0.4 + +test-suite test-bytestring-lazy + default-language: Haskell2010 + hs-source-dirs: test, src + + type: exitcode-stdio-1.0 + main-is: test-text-lazy.hs + ghc-options: -Wall -Wno-orphans + other-modules: + SDP.Text.Lazy + SDP.Text + + build-depends: + base >= 4.12 && < 5, + sdp >= 0.2 && < 0.3, + text >= 1.2 && < 1.3, + sdp-io >= 0.2 && < 0.3, + + QuickCheck >= 2.12 && < 3, + sdp-quickcheck >= 0.2 && < 0.3, + quickcheck-instances >= 0.3 && < 0.4, + + test-framework >= 0.8 && < 0.9, + test-framework-quickcheck2 >= 0.3 && < 0.4 + + diff --git a/src/SDP/Text.hs b/src/SDP/Text.hs new file mode 100644 --- /dev/null +++ b/src/SDP/Text.hs @@ -0,0 +1,320 @@ +{-# LANGUAGE Trustworthy, MagicHash, BangPatterns, UnboxedTuples #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +{- | + Module : SDP.Text + Copyright : (c) Andrey Mulik 2020 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : non-portable (GHC only) + + "SDP.Text" provides @sdp@ instances for strict 'Text'. +-} +module SDP.Text +( + -- * Exports + module System.IO.Classes, + module SDP.IndexedM, + + -- * Strict text + SText, Text, T.toCaseFold, T.toLower, T.toUpper, T.toTitle +) +where + +import Prelude () +import SDP.SafePrelude +import SDP.IndexedM + +import SDP.Prim.SBytes + +import Data.Text.Internal ( Text (..) ) +import Data.Text.Array ( Array (..) ) + +import Data.Text.Internal.Fusion ( Stream (..), Step (..), stream ) +import qualified Data.Text.IO as IO +import qualified Data.Text as T + +import Data.Coerce +import Data.Maybe +import Data.Bits +import Data.Char + +import GHC.Base + ( + Char (..), Int (..), + + shrinkMutableByteArray#, unsafeFreezeByteArray#, + + uncheckedIShiftL#, word2Int#, chr#, (+#), (-#) + ) + +import GHC.Word ( Word16 (..) ) +import GHC.ST ( ST (..) ) + +import System.IO.Classes + +import Control.Exception.SDP + +default () + +-------------------------------------------------------------------------------- + +-- | 'Text' alias, may reduce ambiguity. +type SText = Text + +-------------------------------------------------------------------------------- + +{- Nullable and Estimate instances. -} + +instance Nullable Text + where + isNull = T.null + lzero = T.empty + +instance Estimate Text + where + {-# INLINE (<.=>) #-} + (<.=>) = T.compareLength + + {-# INLINE (<==>) #-} + xs <==> ys = xs `T.compareLength` sizeOf ys + +-------------------------------------------------------------------------------- + +{- Bordered, Linear and Split instances. -} + +instance Bordered Text Int + where + lower _ = 0 + upper ts = sizeOf ts - 1 + bounds ts = (0, sizeOf ts - 1) + sizeOf = T.length + +instance Linear Text Char + where + uncons' = T.uncons + unsnoc' = T.unsnoc + + uncons = fromMaybe (pfailEx "(:>)") . T.uncons + unsnoc = fromMaybe (pfailEx "(:<)") . T.unsnoc + single = T.singleton + toHead = T.cons + toLast = T.snoc + + (++) = T.append + (!^) = T.index + head = T.head + last = T.last + tail = T.tail + init = T.init + + write es = (es //) . single ... (,) + + replicate n e = T.replicate n (T.singleton e) + + fromList = T.pack + reverse = T.reverse + + listR = T.unpack . reverse + listL = T.unpack + force = T.copy + + concat = T.concat . toList + filter = T.filter + + concatMap f = concat . foldr ((:) . f) [] + intersperse = T.intersperse + partition = T.partition + + ofoldr f base = fold' . stream + where + fold' (Stream nxt s0 _) = go 0 s0 + where + go !i !s = case nxt s of + Yield x s' -> f i x (go (i + 1) s') + Skip s' -> go i s' + Done -> base + + ofoldl f base' = fold' . stream + where + fold' (Stream nxt s0 _) = go base' 0 s0 + where + go base !i !s = case nxt s of + Yield x s' -> go (f i base x) (i + 1) s' + Skip s' -> go base i s' + Done -> base + + o_foldr = T.foldr + o_foldl = T.foldl + +instance Split Text Char + where + take = T.take + drop = T.drop + keep = T.takeEnd + sans = T.dropEnd + split = T.splitAt + + splitsBy = T.split + splitsOn = T.splitOn + + replaceBy = T.replace + chunks = T.chunksOf + + isPrefixOf = T.isPrefixOf + isSuffixOf = T.isSuffixOf + isInfixOf = T.isInfixOf + + justifyL = T.justifyLeft + justifyR = T.justifyRight + + prefix p = T.foldr (\ e c -> p e ? c + 1 $ 0) 0 + suffix p = T.foldl (\ c e -> p e ? c + 1 $ 0) 0 + + takeWhile = T.takeWhile + dropWhile = T.dropWhile + + takeEnd = T.takeWhileEnd + dropEnd = T.dropWhileEnd + +-------------------------------------------------------------------------------- + +{- Map and Indexed instances. -} + +instance Map Text Int Char + where + toMap ascs = isNull ascs ? Z $ assoc (l, u) ascs + where + l = fst $ minimumBy cmpfst ascs + u = fst $ maximumBy cmpfst ascs + + toMap' defvalue ascs = isNull ascs ? Z $ assoc' (l, u) defvalue ascs + where + l = fst $ minimumBy cmpfst ascs + u = fst $ maximumBy cmpfst ascs + + Z // ascs = toMap ascs + es // ascs = runST $ thaw es >>= (`overwrite` ascs) >>= done + + (.!) = T.index + + kfoldr = ofoldr + kfoldl = ofoldl + +instance Indexed Text Int Char + where + assoc bnds ascs = runST $ fromAssocs bnds ascs >>= done + + assoc' bnds defvalue ascs = runST $ fromAssocs' bnds defvalue ascs >>= done + + fromIndexed es = runST $ fromIndexed' es >>= done + +-------------------------------------------------------------------------------- + +instance Thaw (ST s) Text (STBytes# s Char) + where + thaw es = filled (sizeOf es) '\0' >>= unzip# (textRepack es) + +instance Freeze (ST s) (STBytes# s Char) Text + where + unsafeFreeze = zip# + freeze = copied >=> unsafeFreeze + +instance (MonadIO io) => Thaw io Text (MIOBytes# io Char) + where + unsafeThaw = pack' . unsafeThaw + thaw = pack' . thaw + +instance (MonadIO io) => Freeze io (MIOBytes# io Char) Text + where + unsafeFreeze (MIOBytes# es) = stToMIO (unsafeFreeze es) + freeze (MIOBytes# es) = stToMIO (freeze es) + +-------------------------------------------------------------------------------- + +{- IsFile and IsTextFile instances. -} + +instance IsFile Text + where + hGetContents = liftIO . IO.hGetContents + hPutContents = liftIO ... IO.hPutStr + +instance IsTextFile Text + where + hPutStrLn = liftIO ... IO.hPutStrLn + hGetLine = liftIO . IO.hGetLine + hPutStr = liftIO ... IO.hPutStr + +-------------------------------------------------------------------------------- + +{- + Note: + @SDP@ structures (Bytes#, Bytes, Ublist, ByteList) stores characters + pessimistically (by 32 bit), and provides random access. @Text@ stores data + more tightly and prefer stream access. +-} +zip# :: STBytes# s Char -> ST s Text +zip# es = go o o + where + go i j@(I# j#) = if i < n + then do c <- es !#> i; o' <- write# es' c j; go (i + 1) (j + o') + + else ST $ \ s1# -> case shrinkMutableByteArray# marr# j# s1# of + s2# -> case unsafeFreezeByteArray# marr# s2# of + (# s3#, text# #) -> (# s3#, Text (Array text#) 0 j #) + + marr# = unpackSTBytes# es + es' = unsafeCoerceSTBytes# es -- [safe]: Char => Word16 + + o = I# (offsetSTBytes# es) + n = sizeOf es + +unzip# :: SBytes# Word16 -> STBytes# s Char -> ST s (STBytes# s Char) +unzip# src marr = do go 0 0; return marr + where + go i j = when (i < sizeOf src) $ if lo >= 0xD800 && lo <= 0xDBFF + then do writeM marr j (u16c lo hi); go (i + 2) (j + 1) + else do writeM marr j (w2c lo); go (i + 1) (j + 1) + where + lo = src !^ i + hi = src !^ (i + 1) + +write# :: STBytes# s Word16 -> Char -> Int -> ST s Int +write# es c i = if n < 0x10000 + then do writeM es i c'; return 1 + else do writeM es i lo; writeM es (i + 1) hi; return 2 + where + n = ord c + m = n - 0x10000 + c' = fromIntegral n + lo = fromIntegral $ (m `shiftR` 10) + 0xD800 + hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 + +-------------------------------------------------------------------------------- + +pack' :: (MonadIO io) => ST RealWorld (STBytes# RealWorld e) -> io (MIOBytes# io e) +pack' = stToMIO . coerce + +-- Pack 'Text' as SBytes# without representation changes. +{-# INLINE textRepack #-} +textRepack :: Text -> SBytes# Word16 +textRepack (Text (Array text#) o n) = drop o (packSBytes# n text#) + +{-# INLINE done #-} +done :: STBytes# s Char -> ST s Text +done = unsafeFreeze + +{-# INLINE u16c #-} +u16c :: Word16 -> Word16 -> Char +u16c (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#)) + where + !upper# = uncheckedIShiftL# (word2Int# a# -# 0xD800#) 10# + !lower# = word2Int# b# -# 0xDC00# + +{-# INLINE w2c #-} +w2c :: Word16 -> Char +w2c (W16# w#) = C# (chr# (word2Int# w#)) + +pfailEx :: String -> a +pfailEx = throw . PatternMatchFail . showString "in SDP.Text." + diff --git a/src/SDP/Text/Builder.hs b/src/SDP/Text/Builder.hs new file mode 100644 --- /dev/null +++ b/src/SDP/Text/Builder.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +{- | + Module : SDP.Text.Builder + Copyright : (c) Andrey Mulik 2021 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : non-portable (requires non-portable module) + + "SDP.Text.Builder" provides @sdp@ instances for text 'Builder'. + + Note that 'Builder' is a service type for efficient @Text@ creation which + isn't intended for element-wise operations and content changes. 'Linear' + instance provided for convenience and many functions (folds, selections, + etc.) creates intermediate structures (text, string, etc.). +-} +module SDP.Text.Builder +( + -- * Export + module SDP.Linear, + + -- * Builder + Builder, fromText, toLazyText, fromLazyText, flush +) +where + +import Prelude () +import SDP.SafePrelude +import SDP.Text.Lazy +import SDP.Linear + +import Data.Text.Lazy.Builder + +default () + +-------------------------------------------------------------------------------- + +instance Nullable Builder + where + isNull = (== mempty) + lzero = mempty + +instance Linear Builder Char + where + fromFoldable = fromLazyText . fromFoldable + fromListN = fromLazyText ... fromListN + replicate = fromText ... replicate + fromList = fromString + single = singleton + + toHead e es = singleton e <> es + toLast es e = es <> singleton e + + listL = listL . toLazyText + listR = listR . toLazyText + (++) = (<>) + + reverse = fromLazyText . reverse . toLazyText + + concatMap = foldMap + concat = fold + + force = fromLazyText . toLazyText + + tail = fromLazyText . tail . toLazyText + init = fromLazyText . init . toLazyText + head = head . toLazyText + last = last . toLazyText + + partition f = both fromLazyText . partition f . toLazyText + intersperse e = fromLazyText . intersperse e . toLazyText + filter p = fromLazyText . filter p . toLazyText + + nubBy f = fromLazyText . nubBy f . toLazyText + nub = fromLazyText . nub . toLazyText + + ofoldr f base = ofoldr f base . toLazyText + ofoldl f base = ofoldl f base . toLazyText + ofoldr' f base = ofoldr' f base . toLazyText + ofoldl' f base = ofoldl' f base . toLazyText + + o_foldr f base = o_foldr f base . toLazyText + o_foldl f base = o_foldl f base . toLazyText + o_foldr' f base = o_foldr' f base . toLazyText + o_foldl' f base = o_foldl' f base . toLazyText + +-------------------------------------------------------------------------------- + +instance IsFile Builder + where + hGetContents = fmap fromLazyText . hGetContents + hPutContents hdl = hPutContents hdl . toLazyText + +instance IsTextFile Builder + where + hGetLine = fmap fromLazyText . hGetLine + hPutStrLn hdl = hPutStrLn hdl . toLazyText + hPutStr hdl = hPutStr hdl . toLazyText + + diff --git a/src/SDP/Text/Lazy.hs b/src/SDP/Text/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/SDP/Text/Lazy.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE Safe, MagicHash, MultiParamTypeClasses, FlexibleInstances #-} + +{- | + Module : SDP.Text.Lazy + Copyright : (c) Andrey Mulik 2020 + License : BSD-style + Maintainer : work.a.mulik@gmail.com + Portability : non-portable (GHC extensions) + + "SDP.Text.Lazy" provides @sdp@ instances for lazy 'Text'. +-} +module SDP.Text.Lazy +( + -- * Exports + module System.IO.Classes, + + module SDP.IndexedM, + + -- * Lazy text + LText, Text, L.toCaseFold, L.toLower, L.toUpper, L.toTitle, + L.fromChunks, L.toChunks, L.toStrict, L.fromStrict, + L.foldrChunks, L.foldlChunks +) +where + +import Prelude () +import SDP.SafePrelude +import SDP.IndexedM +import SDP.Text () + +import qualified Data.Text.Lazy.IO as IO +import qualified Data.Text.Lazy as L + +import Data.Text.Lazy ( Text ) +import Data.Maybe + +import SDP.Templates.AnyChunks +import SDP.ByteList.IOUblist +import SDP.ByteList.STUblist + +import Control.Exception.SDP + +import System.IO.Classes + +default () + +-------------------------------------------------------------------------------- + +-- | 'Text' alias, may reduce ambiguity. +type LText = Text + +-------------------------------------------------------------------------------- + +{- Nullable and Estimate instances. -} + +instance Nullable Text + where + isNull = L.null + lzero = L.empty + +instance Estimate Text + where + {-# INLINE (<.=>) #-} + xs <.=> n = xs `L.compareLength` fromIntegral n + + {-# INLINE (<==>) #-} + xs <==> ys = xs `L.compareLength` L.length ys + +-------------------------------------------------------------------------------- + +{- Bordered, Linear and Split instances. -} + +instance Bordered Text Int + where + lower _ = 0 + upper ts = sizeOf ts - 1 + bounds ts = (0, sizeOf ts - 1) + sizeOf = fromIntegral . L.length + +instance Linear Text Char + where + uncons' = L.uncons + unsnoc' = L.unsnoc + + uncons = fromMaybe (pfailEx "(:>)") . L.uncons + unsnoc = fromMaybe (pfailEx "(:<)") . L.unsnoc + single = L.singleton + toHead = L.cons + toLast = L.snoc + + (++) = L.append + head = L.head + last = L.last + tail = L.tail + init = L.init + + (!^) es = L.index es . fromIntegral + + write es = (es //) . single ... (,) + + replicate n e = L.replicate (fromIntegral n) (L.singleton e) + + fromList = L.pack + reverse = L.reverse + + force = L.fromChunks . map force . L.toChunks + listR = L.unpack . reverse + listL = L.unpack + + concat = L.concat . toList + filter = L.filter + + concatMap f = concat . foldr ((:) . f) [] + + intersperse = L.intersperse + partition = L.partition + + ofoldr f = + let go = \ ch (i, acc) -> (i + sizeOf ch, ofoldr (f . (+ i)) acc ch) + in snd ... L.foldrChunks go . (,) 0 + + ofoldl f base text = + let go = \ (i, acc) ch -> (i + sizeOf ch, ofoldl (f . (+ i)) acc ch) + in snd $ L.foldlChunks go (upper text, base) text + + o_foldl' = L.foldl' + o_foldr = L.foldr + o_foldl = L.foldl + +instance Split Text Char + where + take = L.take . fromIntegral + drop = L.drop . fromIntegral + keep = L.takeEnd . fromIntegral + sans = L.dropEnd . fromIntegral + split = L.splitAt . fromIntegral + chunks = L.chunksOf . fromIntegral + + replaceBy = L.replace + splitsOn = L.splitOn + splitsBy = L.split + + justifyL = L.justifyLeft . fromIntegral + justifyR = L.justifyRight . fromIntegral + + isPrefixOf = L.isPrefixOf + isSuffixOf = L.isSuffixOf + isInfixOf = L.isInfixOf + + prefix p = L.foldr (\ e c -> p e ? c + 1 $ 0) 0 + suffix p = L.foldl (\ c e -> p e ? c + 1 $ 0) 0 + + takeWhile = L.takeWhile + dropWhile = L.dropWhile + takeEnd = L.takeWhileEnd + dropEnd = L.dropWhileEnd + +-------------------------------------------------------------------------------- + +{- Map and Indexed instances. -} + +instance Map Text Int Char + where + toMap ascs = isNull ascs ? Z $ assoc (l, u) ascs + where + l = fst $ minimumBy cmpfst ascs + u = fst $ maximumBy cmpfst ascs + + toMap' defvalue ascs = isNull ascs ? Z $ assoc' (l, u) defvalue ascs + where + l = fst $ minimumBy cmpfst ascs + u = fst $ maximumBy cmpfst ascs + + Z // ascs = toMap ascs + es // ascs = runST $ thaw es >>= (`overwrite` ascs) >>= done + + (.!) es = L.index es . fromIntegral + + kfoldr' = ofoldr' + kfoldl' = ofoldl' + kfoldr = ofoldr + kfoldl = ofoldl + +instance Indexed Text Int Char + where + assoc bnds ascs = runST $ fromAssocs bnds ascs >>= done + + assoc' bnds defvalue ascs = runST $ fromAssocs' bnds defvalue ascs >>= done + + fromIndexed es = runST $ fromIndexed' es >>= done + +-------------------------------------------------------------------------------- + +{- Thaw and Freeze instances. -} + +instance Thaw (ST s) Text (STUblist s Char) + where + unsafeThaw = fromChunksM <=< mapM unsafeThaw . L.toChunks + thaw = fromChunksM <=< mapM thaw . L.toChunks + +instance Freeze (ST s) (STUblist s Char) Text + where + unsafeFreeze = fmap L.fromChunks . mapM unsafeFreeze . toChunks + freeze = fmap L.fromChunks . mapM freeze . toChunks + +instance (MonadIO io) => Thaw io Text (MIOUblist io Char) + where + unsafeThaw = fromChunksM <=< mapM unsafeThaw . L.toChunks + thaw = fromChunksM <=< mapM thaw . L.toChunks + +instance (MonadIO io) => Freeze io (MIOUblist io Char) Text + where + unsafeFreeze = fmap L.fromChunks . mapM unsafeFreeze . toChunks + freeze = fmap L.fromChunks . mapM freeze . toChunks + +-------------------------------------------------------------------------------- + +{- IsFile and IsTextFile instances. -} + +instance IsFile Text + where + hGetContents = liftIO . IO.hGetContents + hPutContents = liftIO ... IO.hPutStr + +instance IsTextFile Text + where + hPutStrLn = liftIO ... IO.hPutStrLn + hGetLine = liftIO . IO.hGetLine + hPutStr = liftIO ... IO.hPutStr + +-------------------------------------------------------------------------------- + +done :: STUblist s Char -> ST s Text +done = freeze + +pfailEx :: String -> a +pfailEx = throw . PatternMatchFail . showString "in SDP.Text.Lazy." + + + diff --git a/test/test-text-lazy.hs b/test/test-text-lazy.hs new file mode 100644 --- /dev/null +++ b/test/test-text-lazy.hs @@ -0,0 +1,110 @@ +module Main where + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 + +import SDP.Text.Lazy + +import Test.SDP + +import Test.QuickCheck.Instances.Text () + +default () + +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain + [ + -- common tests + testProperty "lazy-text-eq " eqProp, + testProperty "lazy-text-ord " ordProp, + testProperty "lazy-text-lexicographic " lgoProp, + + -- linear tests + testProperty "lazy-text-linear-basic " basicLinearProp, + testProperty "lazy-text-linear-decons " deconstructionLinearProp, + testProperty "lazy-text-linear-cons " constructionLinearProp, + testProperty "lazy-text-linear-reverse " reverseProp, + testProperty "lazy-text-linear-concat " concatProp, + + -- split test + testProperty "lazy-text-split " splitProp, + + -- indexed tests + testProperty "lazy-text-indexed-basic " basicIndexedProp, + testProperty "lazy-text-indexed-assoc " assocIndexedProp, + testProperty "lazy-text-indexed-read " readIndexedProp, + + -- estimate test + testProperty "lazy-text-estimate " estimateProp + ] + +-------------------------------------------------------------------------------- + +{- Eq property. -} + +eqProp :: TestEq Text +eqProp = eqTest + +-------------------------------------------------------------------------------- + +{- Ord property. -} + +ordProp :: TestOrd Text +ordProp = ordTest + +lgoProp :: Long Text -> Long Text -> Bool +lgoProp (Long xs) (Long ys) = lexicographicOrdTest xs ys + +-------------------------------------------------------------------------------- + +{- Linear properties. -} + +basicLinearProp :: Char -> Text -> Bool +basicLinearProp = basicLinearTest + +deconstructionLinearProp :: Text -> Bool +deconstructionLinearProp = deconstructionLinearTest + +constructionLinearProp :: Char -> Text -> Bool +constructionLinearProp = constructionLinearTest + +reverseProp :: Text -> Bool +reverseProp = reverseTest + +replicateProp :: TestLinear Text Char +replicateProp = replicateTest + +concatProp :: Text -> Bool +concatProp = concatTest + +-------------------------------------------------------------------------------- + +{- Split property. -} + +splitProp :: Char -> TestSplit Text +splitProp = splitTest . (>) + +-------------------------------------------------------------------------------- + +{- Indexed property. -} + +basicIndexedProp :: TestIndexed Text Int +basicIndexedProp = basicIndexedTest + +assocIndexedProp :: TestIndexed Text Int +assocIndexedProp = assocIndexedTest + +readIndexedProp :: TestIndexed Text Int +readIndexedProp = readIndexedTest + +-------------------------------------------------------------------------------- + +{- Estimate property. -} + +estimateProp :: TestEstimate Text +estimateProp = estimateTest + + + diff --git a/test/test-text-strict.hs b/test/test-text-strict.hs new file mode 100644 --- /dev/null +++ b/test/test-text-strict.hs @@ -0,0 +1,110 @@ +module Main where + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 + +import SDP.Text + +import Test.SDP + +import Test.QuickCheck.Instances.Text () + +default () + +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain + [ + -- common tests + testProperty "strict-text-eq " eqProp, + testProperty "strict-text-ord " ordProp, + testProperty "strict-text-lexicographic " lgoProp, + + -- linear tests + testProperty "strict-text-linear-basic " basicLinearProp, + testProperty "strict-text-linear-decons " deconstructionLinearProp, + testProperty "strict-text-linear-cons " constructionLinearProp, + testProperty "strict-text-linear-reverse " reverseProp, + testProperty "strict-text-linear-concat " concatProp, + + -- split test + testProperty "strict-text-split " splitProp, + + -- indexed tests + testProperty "strict-text-indexed-basic " basicIndexedProp, + testProperty "strict-text-indexed-assoc " assocIndexedProp, + testProperty "strict-text-indexed-read " readIndexedProp, + + -- estimate test + testProperty "strict-text-estimate " estimateProp + ] + +-------------------------------------------------------------------------------- + +{- Eq property. -} + +eqProp :: TestEq Text +eqProp = eqTest + +-------------------------------------------------------------------------------- + +{- Ord property. -} + +ordProp :: TestOrd Text +ordProp = ordTest + +lgoProp :: Long Text -> Long Text -> Bool +lgoProp (Long xs) (Long ys) = lexicographicOrdTest xs ys + +-------------------------------------------------------------------------------- + +{- Linear properties. -} + +basicLinearProp :: Char -> Text -> Bool +basicLinearProp = basicLinearTest + +deconstructionLinearProp :: Text -> Bool +deconstructionLinearProp = deconstructionLinearTest + +constructionLinearProp :: Char -> Text -> Bool +constructionLinearProp = constructionLinearTest + +reverseProp :: Text -> Bool +reverseProp = reverseTest + +replicateProp :: TestLinear Text Char +replicateProp = replicateTest + +concatProp :: Text -> Bool +concatProp = concatTest + +-------------------------------------------------------------------------------- + +{- Split property. -} + +splitProp :: Char -> TestSplit Text +splitProp = splitTest . (>) + +-------------------------------------------------------------------------------- + +{- Indexed property. -} + +basicIndexedProp :: TestIndexed Text Int +basicIndexedProp = basicIndexedTest + +assocIndexedProp :: TestIndexed Text Int +assocIndexedProp = assocIndexedTest + +readIndexedProp :: TestIndexed Text Int +readIndexedProp = readIndexedTest + +-------------------------------------------------------------------------------- + +{- Estimate property. -} + +estimateProp :: TestEstimate Text +estimateProp = estimateTest + + +