diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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`. diff --git a/Uniform/Strings/Conversion.hs b/Uniform/Strings/Conversion.hs --- a/Uniform/Strings/Conversion.hs +++ b/Uniform/Strings/Conversion.hs @@ -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 diff --git a/test/Testing.hs b/test/Testing.hs new file mode 100644 --- /dev/null +++ b/test/Testing.hs @@ -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 diff --git a/test/Uniform/Strings/Conversion_test.hs b/test/Uniform/Strings/Conversion_test.hs new file mode 100644 --- /dev/null +++ b/test/Uniform/Strings/Conversion_test.hs @@ -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] diff --git a/test/Uniform/Strings/Infix_test.hs b/test/Uniform/Strings/Infix_test.hs new file mode 100644 --- /dev/null +++ b/test/Uniform/Strings/Infix_test.hs @@ -0,0 +1,29 @@ +----------------------------------------------------------------------------- +-- +-- Module : StringInfix + +-- infix operations with 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 + + diff --git a/test/Uniform/Strings/Utilities_test.hs b/test/Uniform/Strings/Utilities_test.hs new file mode 100644 --- /dev/null +++ b/test/Uniform/Strings/Utilities_test.hs @@ -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 diff --git a/uniform-strings.cabal b/uniform-strings.cabal --- a/uniform-strings.cabal +++ b/uniform-strings.cabal @@ -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 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