uniform-strings 0.1.3 → 0.1.3.1
raw patch · 7 files changed
+766/−28 lines, 7 filesdep +HTFdep +quickcheck-textdep +snap-coredep −text-icudep ~uniform-algebras
Dependencies added: HTF, quickcheck-text, snap-core, test-invariant, uniform-strings
Dependencies removed: text-icu
Dependency ranges changed: uniform-algebras
Files
- README.md +2/−0
- Uniform/Strings/Conversion.hs +26/−25
- test/Testing.hs +27/−0
- test/Uniform/Strings/Conversion_test.hs +435/−0
- test/Uniform/Strings/Infix_test.hs +29/−0
- test/Uniform/Strings/Utilities_test.hs +212/−0
- uniform-strings.cabal +35/−3
README.md view
@@ -28,6 +28,8 @@ This is a package in `uniformBase` and other uniform packages will build on it. +It may require + debian: apt-get install libicu-dev To Do: The code originated in 2010 to 2018. It will be revised and the dependencies greatly reduced when using `text` and `basement`.
Uniform/Strings/Conversion.hs view
@@ -35,7 +35,7 @@ -- uses UTF8 as encoding in ByteString -- urlencode is always represented the same as the input , Text (..), BSUTF (..), URL (..)- -- , URLform , b2uf, b2urlf, urlf2b,+ , URLform , b2uf, b2urlf, urlf2b , b2bu, bu2b, bu2s, bu2t, t2bu, s2bu , u2b, u2t, u2s, b2u@@ -69,7 +69,7 @@ import Data.Text.Encoding (decodeUtf8, decodeUtf8', encodeUtf8) import qualified Network.URI as URI--- import qualified Snap.Core as SN+import qualified Snap.Core as SN import qualified Data.Text.Lazy as LText -- (toStrict, fromStrict) @@ -207,38 +207,39 @@ -- case for encoding of form content (with + for space)--- removed for 9.2.1 --- newtype URLform = URLform ByteString deriving (Show, Eq)--- unURLform :: URLform -> ByteString--- unURLform (URLform t) = t+-- to remove for 9.2.1 +newtype URLform = URLform ByteString deriving (Show, Eq)+unURLform :: URLform -> ByteString+unURLform (URLform t) = t --- b2urlf :: ByteString -> URLform--- -- ^ convert string to url (uses code from SNAP, which converts space into +)--- b2urlf = URLform . SN.urlEncode --- urlf2b :: URLform -> ByteString--- -- ^ convert url to string (uses code from SNAP, which converts space into +)--- urlf2b = fromJustNote "urlf2b nothing" . SN.urlDecode . unURLform+b2urlf :: ByteString -> URLform+-- ^ convert string to url (uses code from SNAP, which converts space into +)+b2urlf = URLform . SN.urlEncode +urlf2b :: URLform -> ByteString+-- ^ convert url to string (uses code from SNAP, which converts space into +)+urlf2b = fromJustNote "urlf2b nothing" . SN.urlDecode . unURLform --- testUrlEncodingSNAP :: ByteString -> Bool--- testUrlEncodingSNAP a = maybe False ((a ==). SN.urlEncode) . SN.urlDecode $ a++testUrlEncodingSNAP :: ByteString -> Bool+testUrlEncodingSNAP a = maybe False ((a ==). SN.urlEncode) . SN.urlDecode $ a --- urlf2u :: URLform -> ByteString--- urlf2u = unURLform--- u2urlf :: ByteString -> Maybe URLform--- u2urlf a = if testUrlEncodingSNAP a then Just (URLform a) else Nothing--- -- this test allows control in url encoded strings ...+urlf2u :: URLform -> ByteString+urlf2u = unURLform+u2urlf :: ByteString -> Maybe URLform+u2urlf a = if testUrlEncodingSNAP a then Just (URLform a) else Nothing+-- this test allows control in url encoded strings ... --- b2uf :: ByteString -> ByteString--- -- ^ convert ByteString to url (uses code from SNAP which converts space into +)--- b2uf = urlf2u . b2urlf+b2uf :: ByteString -> ByteString+-- ^ convert ByteString to url (uses code from SNAP which converts space into +)+b2uf = urlf2u . b2urlf --- uf2b :: ByteString -> Maybe ByteString --not inverse--- -- ^ convert url to ByteString (uses code from SNAP, which converts space into +)--- uf2b = fmap urlf2b . u2urlf+uf2b :: ByteString -> Maybe ByteString --not inverse+-- ^ convert url to ByteString (uses code from SNAP, which converts space into +)+uf2b = fmap urlf2b . u2urlf t2u :: Text -> Text
+ test/Testing.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+--+-- Module : for automatic test+-- insert {-@ HTF_TESTS @-} for each import+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++-- module Spec where -- must have Main (main) or Main where++--import Uniform.Strings+import Test.Framework+import Uniform.Strings.Conversion_test+ ( htf_Uniform_Strings_Conversion_test_thisModulesTests )+import {-@ HTF_TESTS @-} Uniform.Strings.Infix_test+import {-@ HTF_TESTS @-} Uniform.Strings.Utilities_test++main = do+ putStrLn "LitFoundation.hs:\n"+ -- r <- htfMain htf_thisModulesTests -- if local tests+ -- putStrLn ("tree tagger test:\n" ++ show r)+ r <- htfMain htf_importedTests+ -- putStrLn ("other tests t:\n" ++ show r)+ return ()+++-- examples
+ test/Uniform/Strings/Conversion_test.hs view
@@ -0,0 +1,435 @@+-----------------------------------------------------------------------------+--+-- Module : Strings+-- Copyright :+--+-- | a module to convert between character string encodings+--++-- would require systematic checks what are permited characters+-- (especially for input to urlEncoding)++-- the latin encoding is produced by show ...+-- t2u is nearly invertible...++-- strings remain here, to be used when constructing the wrappers for+-- functions used from other packages (with String interfaces)++-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+--{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE PackageImports #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -w #-}++module Uniform.Strings.Conversion_test where++import Data.Text.Arbitrary ()+import Test.Framework+import Test.Invariant (inverts)+import Uniform.Strings.Conversion+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as Lazy+import Data.ByteString.Char8 (pack, unpack)+import qualified Network.URI as URI+import qualified Snap.Core as SN++--import Safe+--import Control.Monad (join)+--import Data.ByteString.Arbitrary+-- does not produce a simple Arbitrary for Bytestring, could be converted?+++-- import "monads-tf" Control.Monad.State (MonadIO, liftIO)++-- import GHC.Exts( IsString(..) )++--import Data.Text (Text)+--import qualified Data.Text as T+import Data.Char (ord)+import Control.Monad (join)+import Data.Text.Encoding (decodeUtf8, decodeUtf8', encodeUtf8)+--import Data.ByteString (ByteString)+--import qualified Data.ByteString as ByteString+--import qualified Data.ByteString.Lazy as Lazy+--import Data.ByteString.Char8 (pack, unpack)+---- An efficient compact, immutable byte string type (both strict and lazy)+---- suitable for binary or 8-bit character data.+---- import qualified Data.ByteString.UTF8 as BSUTF (toString, fromString)+---- toString replaces invalid chars with '\xFFFD'+--import Data.Text.Encoding (decodeUtf8, decodeUtf8', encodeUtf8)+---- decode bytestring to text (exception if not valid)+--+---- URL encode (escaped)+----import qualified Network.HTTP as HTTP (urlDecode, urlEncode)+--import qualified Network.URI as URI+--import qualified Snap.Core as SN+--+--import Data.Text.ICU.Convert as ICU -- all conversion stuff, neede for tests++instance Arbitrary ByteString where arbitrary = ByteString.pack <$> arbitrary+instance Arbitrary BSUTF where+ arbitrary = do+ c :: ByteString <- arbitrary+ let t = testByteStringUtf8 c+ if t then return (BSUTF c) else arbitrary+instance Arbitrary URL where+ arbitrary = do+ a <- arbitrary+ return . s2url $ a+-- instance Arbitrary URLform where+-- arbitrary = do+-- a :: ByteString <- arbitrary+-- return . b2urlf $ a+instance Arbitrary BSlat where+ arbitrary = do+ c :: ByteString <- arbitrary+ return $ BSlat c+-- let t = testByteStringUtf8 c+-- if t then return (BSUTF c) else arbitrary++prop_t2b ::Text -> Bool+prop_t2b a = maybe True (a ==) (b2t . t2b $ a)++prop_b2t :: ByteString -> Bool+prop_b2t a = maybe True ((a==) . t2b) mb+ where mb = b2t a++prop_t2bu :: Text -> Bool+prop_t2bu = inverts bu2t t2bu+prop_bu2t :: BSUTF -> Bool+prop_bu2t = inverts t2bu bu2t++test_SNAPEncode = assertEqual "x+x" (b2uf .s2b $ "x x")+--test_snapEncode = assertEqual "x+x" (b2s . b2u . s2b $ "x x")++prop_t2s :: Text -> Bool+prop_t2s = inverts s2t t2s+prop_s2t :: String -> Bool+prop_s2t = inverts t2s s2t+++testByteStringUtf8 :: ByteString -> Bool+-- ^ test whether a byte string is valid utf8 encoded+-- used for avoiding problems with the quickcheck conversions+testByteStringUtf8 b =+ case decodeUtf8' b of+ -- :: ByteString -> Either UnicodeException Text+ Left s -> False+ Right t -> True+++-- prop_s2url = inverts url2s s2url+-- prop_url2s = inverts s2url url2s+++test_httpEncode = assertEqual "x%20x" (s2u "x x")+--test_snapEncode = assertEqual "x+x" (b2s . b2u . s2b $ "x x")++++-- prop_s2u :: String -> Bool+-- prop_s2u a = maybe False (a==) (u2s . s2u $ a)++test_s2uA = assertEqual (Just "A") (u2s . s2u $ "A")+test_s2uB = assertEqual (Just " ") (u2s . s2u $ " ")+test_s2uB1 = assertEqual "%20" (s2u " ")+test_s2uC1 = assertEqual False (testUrlEncodingURI "%a ")+--test_s2uC2 = assertEqual ("%20") (HTTP.urlDecode "%a ")+test_s2uC2 = assertEqual "%a " (URI.unEscapeString "%a ")+test_s2uC3 = assertEqual Nothing (u2s "%a ")++prop_u2s :: String -> Bool+prop_u2s a = maybe True ((a==) . s2u) mb+ where mb = u2s a++-- case for encoding of form content (with + for space)++-- newtype URLform = URLform ByteString deriving (Show, Eq)+-- unURLform (URLform t) = t+instance Arbitrary URLform where+ arbitrary = do+ a :: ByteString <- arbitrary+ return . b2urlf $ a++prop_t2u :: Text -> Bool+prop_t2u a = maybe True (a==) (u2t . t2u $ a)++prop_b2u :: ByteString -> Bool+prop_b2u a = maybe True (a==) (join . fmap u2b . b2u $ a)++prop_u2t :: Text -> Bool+prop_u2t a = maybe True ((a==) . t2u) mb+ where mb = u2t a++prop_u2b :: ByteString -> Bool+prop_u2b a = maybe True (a==) mb+ where mb = join . fmap b2u . u2b $ a+++prop_b2urlf = inverts urlf2b b2urlf+prop_urlf2b = inverts b2urlf urlf2b++testUrlEncodingSNAP :: ByteString -> Bool+testUrlEncodingSNAP a = maybe False ((a ==). SN.urlEncode) . SN.urlDecode $ a+--testUrlEncodingSNAP a = a == (unURLform . b2urlf . urlf2b . URLform $ a)+-- checks if reencoding with HTTP gives the same URL, thus ok encoding+--testUrlEncodingSNAP a = isJust . SN.urlDecode $ a+-- checks if reencoding with SNAP gives the same URLform, thus ok encoding+-- this test allows control in url encoded strings ...+--+--test_SNAPEncode = assertEqual "x+x" (b2uf .s2b $ "x x")+----test_snapEncode = assertEqual "x+x" (b2s . b2u . s2b $ "x x")+--+--+--+--prop_b2uf :: ByteString -> Bool+--prop_b2uf a = maybe False (a==) (uf2b . b2uf $ a)+--+--test_b2uA = assertEqual (Just "A") (uf2b . b2uf . s2b $ "A")+--test_b2uB = assertEqual (Just " ") (uf2b . b2uf . s2b $ " ")+--test_b2uB1 = assertEqual "+" (b2uf . s2b $ " ")+--+--prop_uf2b :: ByteString -> Bool+--prop_uf2b a = maybe True ((a==) . b2uf) mb+-- where mb = uf2b a+--+--test_u2b1 = assertEqual (s2b "%01") (b2uf "\SOH")+--test_u2b2 = assertEqual (s2b "%02") (b2uf "\STX")+--test_u2b3 = assertEqual (s2b "%00") (b2uf "\NUL")+--+--test_u2bx1 = assertEqual (Just "\SOH") (uf2b . s2b $ "%01")+--test_u2bx2 = assertEqual (Just "\STX")(uf2b . s2b $ "%02")+--test_u2bx3 = assertEqual (Just "\NUL") (uf2b . s2b $ "%00")+--+----test_u2by1 = assertEqual (Just "\SOH") (u2b "\SOH")+---- with specific test for url:+--test_u2by1 = assertEqual Nothing (uf2b "\SOH")+--test_u2sy1 = assertEqual Nothing (u2s "\SOH")+--+--+---- check if snap and network-uri decode the same+---- the difference is only in the encoding+--+----prop_snap_uri :: String -> Bool+----prop_snap_uri = (testUrlEncodingSNAP . s2b) <=> (testUrlEncodingURI )+---- except "!" "$"(see test_u2by2 u2sy2)+--+----prop_snap_uri_decode :: String -> Bool+----prop_snap_uri_decode = ( uf2b . s2b) <=> (fmap s2b . u2s )+---- the actual decoding is different for some chars, e.g.:+--+--test_u2by2 = assertEqual (Just "!") (uf2b "!")+--test_u2sy2 = assertEqual Nothing (u2s "!")+--test_u2by3 = assertEqual (Just "$") (uf2b "$")+--test_u2sy3 = assertEqual Nothing (u2s "$")+--test_u2by4 = assertEqual Nothing (uf2b "~")+--test_u2sy4 = assertEqual (Just "~") (u2s "~")+--test_u2by5 = assertEqual (Just " ") (uf2b "+")+--test_u2sy5 = assertEqual Nothing(u2s "+")+--test_u2by6 = assertEqual (Just ")") (uf2b ")")+--test_u2sy6 = assertEqual Nothing(u2s ")")+--test_u2by6a = assertEqual (Just "(") (uf2b "(")+--test_u2sy6a = assertEqual Nothing(u2s "(")+--test_u2by7 = assertEqual Nothing (uf2b "\"")+--test_u2sy7 = assertEqual Nothing (u2s "\"")+--test_u2by8 = assertEqual (Just ",") (uf2b ",")+--test_u2sy8 = assertEqual Nothing (u2s ",")+--+--+--prop_b2uf :: ByteString -> Bool+--prop_b2uf a = maybe False (a==) (uf2b . b2uf $ a)+--+--test_b2uA = assertEqual (Just "A") (uf2b . b2uf . s2b $ "A")+--test_b2uB = assertEqual (Just " ") (uf2b . b2uf . s2b $ " ")+--test_b2uB1 = assertEqual "+" (b2uf . s2b $ " ")+--+--prop_uf2b :: ByteString -> Bool+--prop_uf2b a = maybe True ((a==) . b2uf) mb+-- where mb = uf2b a+--+--test_u2b1 = assertEqual (s2b "%01") (b2uf "\SOH")+--test_u2b2 = assertEqual (s2b "%02") (b2uf "\STX")+--test_u2b3 = assertEqual (s2b "%00") (b2uf "\NUL")+--+--test_u2bx1 = assertEqual (Just "\SOH") (uf2b . s2b $ "%01")+--test_u2bx2 = assertEqual (Just "\STX")(uf2b . s2b $ "%02")+--test_u2bx3 = assertEqual (Just "\NUL") (uf2b . s2b $ "%00")+--+----test_u2by1 = assertEqual (Just "\SOH") (u2b "\SOH")+---- with specific test for url:+--test_u2by1 = assertEqual Nothing (uf2b "\SOH")+--test_u2sy1 = assertEqual Nothing (u2s "\SOH")+--+--prop_s2u :: String -> Bool+--prop_s2u a = maybe False (a==) (u2s . s2u $ a)+--+--test_s2uA = assertEqual (Just "A") (u2s . s2u $ "A")+--test_s2uB = assertEqual (Just " ") (u2s . s2u $ " ")+--test_s2uB1 = assertEqual "%20" (s2u " ")+--test_s2uC1 = assertEqual False (testUrlEncodingURI "%a ")+----test_s2uC2 = assertEqual ("%20") (HTTP.urlDecode "%a ")+--test_s2uC2 = assertEqual "%a " (URI.unEscapeString "%a ")+--test_s2uC3 = assertEqual Nothing (u2s "%a ")+--+--prop_u2s :: String -> Bool+--prop_u2s a = maybe True ((a==) . s2u) mb+-- where mb = u2s a+--prop_b2urlf = inverts urlf2b b2urlf+--prop_urlf2b = inverts b2urlf urlf2b+--+--prop_s2url = inverts url2s s2url+--prop_url2s = inverts s2url url2s++testUrlEncodingURI :: String -> Bool+testUrlEncodingURI a = a == (unURL . s2url . url2s . URL $ a)+-- checks if reencoding with HTTP gives the same URL, thus ok encoding+-- input is URL encoded string++--test_httpEncode = assertEqual "x%20x" (s2u "x x")+--test_snapEncode = assertEqual "x+x" (b2s . b2u . s2b $ "x x")++-- check if snap and network-uri decode the same+-- the difference is only in the encoding++--prop_snap_uri :: String -> Bool+--prop_snap_uri = (testUrlEncodingSNAP . s2b) <=> (testUrlEncodingURI )+-- except "!" "$"(see test_u2by2 u2sy2)++--prop_snap_uri_decode :: String -> Bool+--prop_snap_uri_decode = ( uf2b . s2b) <=> (fmap s2b . u2s )+-- the actual decoding is different for some chars, e.g.:++--test_u2by2 = assertEqual (Just "!") (uf2b "!")+--test_u2sy2 = assertEqual Nothing (u2s "!")+--test_u2by3 = assertEqual (Just "$") (uf2b "$")+--test_u2sy3 = assertEqual Nothing (u2s "$")+--test_u2by4 = assertEqual Nothing (uf2b "~")+--test_u2sy4 = assertEqual (Just "~") (u2s "~")+--test_u2by5 = assertEqual (Just " ") (uf2b "+")+--test_u2sy5 = assertEqual Nothing(u2s "+")+--test_u2by6 = assertEqual (Just ")") (uf2b ")")+--test_u2sy6 = assertEqual Nothing(u2s ")")+--test_u2by6a = assertEqual (Just "(") (uf2b "(")+--test_u2sy6a = assertEqual Nothing(u2s "(")+--test_u2by7 = assertEqual Nothing (uf2b "\"")+--test_u2sy7 = assertEqual Nothing (u2s "\"")+--test_u2by8 = assertEqual (Just ",") (uf2b ",")+--test_u2sy8 = assertEqual Nothing (u2s ",")++++--+++-- | bytestring with latin1 encoded characters+--newtype BSlat = BSlat ByteString deriving (Show, Eq)+--unBSlat (BSlat a) = a++--instance Arbitrary BSlat where+-- arbitrary = do+-- c :: ByteString <- arbitrary+-- return $ BSlat c+---- let t = testByteStringUtf8 c+---- if t then return (BSUTF c) else arbitrary+--+++prop_lat2s :: BSlat -> Bool+prop_lat2s = inverts s3lat lat2s++--prop_s2lat :: String -> Bool -- will fail ? fails+--prop_s2lat = inverts lat2s s3lat+++prop_lat2t :: BSlat -> Bool+prop_lat2t = inverts t3lat lat2t++--prop_t3lat :: Text -> Bool -- fails for \402 \419+--prop_t3lat s = inverts lat2t t3lat (s2t . convertLatin . t2s $ s)+++prop_latin2s :: ByteString -> Bool+prop_latin2s = inverts s2latin latin2s -- maybe True ((b ==). latin2s) (s2latin b)++--prop_s2latin :: String -> Bool -- why does this always work? (is the intermediate result ok?)+--prop_s2latin = inverts latin2s s2latin++--prop_s3latin :: String -> Bool --inverts with reasonable intermediate value+--prop_s3latin s = inverts latin2s s2latin (convertLatin s)+++--+prop_latin2t :: ByteString -> Bool+-- the inermediate text is not always meaningful+prop_latin2t = inverts t2latin latin2t++prop_t2latin :: Text -> Bool+--prop_t2latin t = inverts latin2t t2latin t -- fails+prop_t2latin t = if all ((<256) . ord) (t2s t) then inverts latin2t t2latin t else True++prop_t22latin :: Text -> Bool+--prop_t2latin t = inverts latin2t t2latin t -- fails+prop_t22latin t = maybe True ((t==) .latin2t) (t22latin t)++putIOwords = putStrLn . unlines . map t2s++chars = [198, 216, 197, 206, 219,140,252,202, 419, 420, 1937 ]+difficultBString = ByteString.pack chars+difficultTString = "\198\216\197\206\219\140\252\202\419\420\1937"++-- several char are not latin1+--+--test_latin1 :: IO ()+--test_latin1 = do+-- putIOwords ["latin1 start"]+-- conv <- open "ISO-8859-1" Nothing+-- let lat = difficultBString+---- let uni = "ÆØÅ\DEL\200\SOH\206\219\140\252\202" :: Text+-- let a = latin2t lat -- toUnicode conv lat :: Text+-- let b = t2latin a -- fromUnicode conv a+---- let c = fromUnicode conv uni+---- let d = toUnicode conv c :: Text+---- putIOwords [ uni]+-- putIOwords [a, s2t . show . t2s $ a ] -- replacement chars for > 256 , but conversion back is ok+-- -- "\198\216\197\206\219\140\252\202\163\164\145"+-- assertEqual b lat+---- assertEqual d uni+-- putIOwords ["latin1 test end" ]+--+--+--test_latin2 :: IO () -- roundtrip conversion text - latin - text works (after lossy conversion!)+--test_latin2 = do+-- putIOwords ["latin2 start"]+-- conv <- open "ISO-8859-1" Nothing+-- let a0 = difficultTString+-- putIOwords [" a0 is", a0]+-- putIOwords ["a0 is a difficutl string", s2t $ show a0]+-- let a = s2t . convertLatin . t2s $ a0+---- let uni = "ÆØÅ\DEL\200\SOH\206\219\140\252\202" :: Text+-- let b = t2latin a -- fromUnicode conv a+-- let c = latin2t b -- toUnicode conv b+-- -- with conv becomes "\198\216\197\206\219\140\252\202\SUB\SUB\SUB" and fails+-- -- with latin2t becomes "\198\216\197\206\219\140\252\202\163\164\145" and fails+---- let c = fromUnicode conv uni+---- let d = toUnicode conv c :: Text+---- putIOwords [ uni]+-- putIOwords [" a , c is", a , c, "a==c", s2t $ show (a==c)]+-- putIOwords [" a , c is", s2t $ show a , s2t $ show c]+-- assertEqual a c+---- assertEqual d uni+-- putIOwords ["latin2 test end" ]++-- test_fromJust_givesError = assertEqual 1 (fromJustNote' "test_fromJust" (Nothing ::Maybe Int))++-- test_fromJust_old= assertEqual 1 (fromJustNote "test_fromJust" (Nothing ::Maybe Int))+++-- -- todo error or strings+-- fromJustNote' msg mb = case mb of+-- Just r -> r+-- Nothing -> errorT ["fromJust at ", msg , "with arg", showT mb]
+ test/Uniform/Strings/Infix_test.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+--+-- Module : StringInfix++-- infix operations with <X> to insert X in between - unconditional+-- even if the two strings are empty+-- todo - how to compare with similar ops in fileio?++-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -w #-}++module Uniform.Strings.Infix_test where+++--import Data.Char (toUpper, toLower, isSpace)+-- import "monads-tf" Control.Monad.State (MonadIO, liftIO)++import GHC.Exts (IsString (..))+import Test.Framework+import Uniform.Strings.Conversion+import Uniform.Strings.Utilities++
+ test/Uniform/Strings/Utilities_test.hs view
@@ -0,0 +1,212 @@+ -----------------------------------------------------------------------------+--+-- Module : Strings+-- Copyright :+--+-- | a module with a class for strings, sucht that the normal ops are+-- all polymorphic for string and text (and total)+-- the string (i.e. [Char]) functions are the semantic definitions,+-- the other implementation are tested against these.+-- except intercalate, which returns Maybe+-- (the corresponding restrictions for the unlines and unwords functions are not enforced)+--+-- performance can be improved by using the "native" functions+-- could be expanded++-- class niceStrings can be replaced or integrated in the generic strings+-- it may be useful to have more than one show like operation+-----------------------------------------------------------------------------+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings+ , RecordWildCards #-}++{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -w #-}++module Uniform.Strings.Utilities_test+ where++import Uniform.Zero+import Uniform.ListForm+import Uniform.Strings.Utilities+import Uniform.Strings.Conversion++--import Algebra.Laws as Law+import Test.Framework+import Data.Text.Arbitrary+import Test.Invariant as Rule ++-- probably better just to move these module to package uniform-algebra+-- but there is so far only zero++import Data.Char (isSpace, isLower, toLower, toUpper)+import Text.Printf (PrintfArg, PrintfType, printf)++import Data.List as L+--import qualified Data.Vector as V+import GHC.Exts (IsString (..))++--import qualified Data.List.Split as S+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+--import Safe+-- import Uniform.Error (fromJustNote)+-- not possible, because Error is based on String+--import Uniform.StringConversion+import qualified Data.ByteString.Lazy as Lazy+import Uniform.Properties+++prop_zero_mknull_string :: String -> Bool+prop_zero_mknull_string = prop_zero_mknull++prop_assoz_string :: String -> String -> String -> Bool+prop_assoz_string = prop_assoz++prop_concat_string :: [String] -> Bool+prop_concat_string = prop_concat++prop_filterChar_string :: String -> Bool+prop_filterChar_string a = all (cond) af+ where+ cond x = x `notElem` ['a', '\r', '1']+ af = (filterChar cond a)+++--+prop_zero_mknull_text :: Text -> Bool+prop_zero_mknull_text = prop_zero_mknull++prop_assoz_text :: Text -> Text -> Text -> Bool+prop_assoz_text = prop_assoz++prop_concat_text :: [Text] -> Bool+prop_concat_text = prop_concat++prop_filterChar_text :: Text -> Bool+prop_filterChar_text = prop_filterChar++++-- tests that text operations have same semantics than string2maybe putIOwords =liftIOstrings+prop_unwords :: [String] -> Bool+prop_unwords = unwords' . map s2t <=> s2t . unwords++prop_words = words' . s2t <=> map s2t . words++-- not invertible for [""] and not when strings include " "+-- same problem as intervalate!+-- same problem for lines and unlines+--prop_wordsInverse :: [String] -> Bool+--prop_wordsInverse = inverts words' unwords'++prop_unlines = unlines' . map s2t <=> s2t . unlines+prop_lines = lines' . s2t <=> map s2t . lines++prop_append :: String -> String -> Bool+prop_append a b = append' (s2t a) (s2t b) == s2t (append a b)++prop_append2 :: String -> String -> Bool+prop_append2 a b = append a b == reverse (append (reverse b) (reverse a))++prop_null = null' . s2t <=> null+-- prop_toUpper = toUpper' . s2t <=> s2t . toUpper' -- failed for "\223" sz ligature+prop_toLower = toLower' . s2t <=> s2t . toLower'++--prop_toLowerInvers :: String -> Bool+--prop_toLowerInvers = inverts toLower' toUpper'++prop_toLower1 :: String -> Bool+prop_toLower1 = idempotent toLower'+prop_toLower2 :: Text -> Bool+prop_toLower2 = idempotent toLower'++prop_toUpper1 :: String -> Bool+prop_toUpper1 = idempotent toUpper'+prop_toUpper2 :: Text -> Bool+prop_toUpper2 = idempotent toUpper'++-- conversin of lowercase to uper and back is not inverse+--prop_inverse_toUpper :: String -> Bool+--prop_inverse_toUpper a = inverts toLower' toUpper' (toLower' a)+--+--prop_inverse_toUpperT :: Text -> Bool+--prop_inverse_toUpperT a = inverts toLower' toUpper' (toLower' a)++--prop_inverse_toLower :: String -> Bool+--prop_inverse_toLower a = inverts toUpper' toLower' (toUpper' a)+--+--prop_inverse_toLowerT :: Text -> Bool+--prop_inverse_toLowerT a = inverts toUpper' toLower' (toUpper' a)++prop_isPrefixOf a b = isPrefixOf' (s2t a) (s2t b) == isPrefixOf' a b+prop_isInfixOf' a b = isInfixOf' (s2t a) (s2t b) == isInfixOf' a b+prop_stripPrefix'f a b = stripPrefix' (s2t a) (s2t b) == fmap s2t (stripPrefix' a b)++prop_stripPrefix2 :: String -> String -> Bool+prop_stripPrefix2 a b = stripPrefix' a (append' a b) == Just b++-- establish inverse for strings+prop_inverse_intercalate :: String -> [String] -> Bool+prop_inverse_intercalate s a = maybe True (isJust . fmap (a==) . splitOn' s) ( intercalate' s a )+--prop_intercalate :: String -> [String] -> Bool+--prop_intercalate a b = intercalate' (s2t a) (map s2t b) == fmap s2t (intercalate' a b)++prop_trim = trim' . s2t <=> s2t . trim'+prop_trim2 :: String -> Bool+prop_trim2 = idempotent trim'+prop_trim3 :: Text -> Bool+prop_trim3 = idempotent trim'++prop_splitOn_text a b = splitOn' (s2t a) (s2t b) == fmap (map s2t) (splitOn' a b)+prop_splitOn_bytestring a b =+ splitOn' (s2bu a) (s2bu b) == fmap (map s2bu) (splitOn' a b)++prop_splitOn_intercalate :: String -> [String] -> Bool+prop_splitOn_intercalate a b =+ if null a then True+ else if any (a `isInfixOf'`) b then True+ else (maybe True (b==)) (maybe Nothing (splitOn' a)+ ( intercalate' a $ b))+ -- fails on "" [""]++test_splitOn = assertBool ( Just [] == splitOn' [] ("a"::String))+test_bu2s = assertEqual ("a"::String) (toString . t2bu $ ("a" :: Text))++--test_show'_forText = assertEqual ("a"::String) (show' ("a"::String))+-- gives overlapping with [a]+test_show'_forString = assertEqual ("a"::Text) (show' ("a"::Text))++--stringTest :: IO Bool+--stringTest = do+-- let+-- r1 = splitOn' (""::String) ("a"::String) :: Maybe [String]+-- r2 = splitOn' (""::Text) ("a"::Text) :: Maybe [Text]+-- v1 = S.splitOn (""::String) ("a"::String) :: [String]+---- v2 = T.splitOn (""::Text) ("a"::Text) :: [Text] -- produces error+-- w1 = S.splitOn ("x"::String) ("a"::String) :: [String]+-- w2 = T.splitOn ("x"::Text) ("a"::Text) :: [Text]+-- c1 = L.intercalate ("a"::String) ([]::[String]) :: String+-- c2 = T.intercalate ("a"::Text) ([]::[Text]) ::Text+-- d1 = intercalate' ("a"::String) ([]::[String]) ::Maybe String+-- d2 = intercalate' ("a"::Text) ([]::[Text]) ::Maybe Text+-- putIOwordsS ["splitOn on empty input \nfor string", show r1]+-- putIOwords ["\nfor text", show r2, "--"]+-- putIOwordsS ["S.splitOn on empty input \nfor string", show v1] -- ["","a"]+---- putIOwords ["\nT. for text", show v2, "--"] -- produces error+-- putIOwordsS ["S.splitOn on x input \nfor string", show w1] -- ["","a"]+-- putIOwords ["\nT. for text", show w2, "--"] -- produces error+-- putIOwords ["intercalate for string", c1, "-"]+-- putIOwords ["intercalate for text", t2s c2, "-"]+-- putIOwords ["intercalate' for string", show c1, "-"]+-- putIOwords ["intercalate' for text", show c2, "-"]+-- return True
uniform-strings.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: uniform-strings-version: 0.1.3+version: 0.1.3.1 synopsis: Manipulate and convert strings of characters uniformly and consistently description: Reduce complexity of Haskell by providing a .@@ -25,7 +25,8 @@ where the semantic is the same (tested with quickcheck). Tentatively some infix string manipulations are offered as well. .- v 0.1.3 added stack build lts 19.16 for ghc 9.0.2+ - 0.1.3 added stack build lts 19.16 for ghc 9.0.2+ - 0.1.3.1 removed dependency on text-icu . Please see the README on GitHub at <https://github.com/andrewufrank/uniform-strings/readme> category: Data Text Uniform@@ -57,9 +58,40 @@ , network-uri , pretty-show , safe+ , snap-core , split , text- , text-icu , uniform-algebras >=0.1.3 default-language: Haskell2010 autogen-modules: Paths_uniform_strings++test-suite strings-test+ type: exitcode-stdio-1.0+ main-is: Testing.hs+ other-modules:+ Uniform.Strings.Conversion_test+ Uniform.Strings.Infix_test+ Uniform.Strings.Utilities_test+ Paths_uniform_strings+ autogen-modules:+ Paths_uniform_strings+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HTF+ , MissingH+ , base >4.5 && <5+ , bytestring+ , monads-tf+ , network-uri+ , pretty-show+ , quickcheck-text+ , safe+ , snap-core+ , split+ , test-invariant+ , text+ , uniform-algebras+ , uniform-strings+ default-language: Haskell2010