diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for word16 + +## 0.1.0.0 -- 2021-08-21 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2021 Julian Ospald + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ViewPatterns #-} + +module Main where + +import GHC.ST + ( ST (ST), runST ) +import Criterion.Main +import GHC.Exts +import GHC.Word +import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as S +import Data.ByteString.Short.Internal +import Data.Word16 + +asBA :: ShortByteString -> BA +asBA (SBS ba#) = BA# ba# + +data BA = BA# ByteArray# +data MBA s = MBA# (MutableByteArray# s) + + +create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString +create len fill = + runST $ do + mba <- newByteArray len + fill mba + BA# ba# <- unsafeFreezeByteArray mba + return (SBS ba#) +{-# INLINE create #-} + + +main :: IO () +main = do + input <- S.toShort <$> BS.readFile "bench/Bench.hs" + defaultMain [ + bench "Data.Word16" $ whnf (map' Data.Word16.toLower) input + ] + + +map' :: (Word16 -> Word16) -> ShortByteString -> ShortByteString +map' f = \sbs -> + let l = S.length sbs + ba = asBA sbs + in create (l * 2) (\mba -> go ba mba 0 l) + where + go :: BA -> MBA s -> Int -> Int -> ST s () + go !ba !mba !i !l + | i >= l = return () + | otherwise = do + let w = indexWord16Array ba i + writeWord16Array mba i (f w) + go ba mba (i+1) l +{-# INLINE map' #-} + + +writeWord16Array :: MBA s -> Int -> Word16 -> ST s () +writeWord16Array (MBA# mba#) (I# i#) (W16# w#) = + ST $ \s -> case writeWord16Array# mba# i# w# s of + s' -> (# s', () #) + +indexWord16Array :: BA -> Int -> Word16 +indexWord16Array (BA# ba#) (I# i#) = W16# (indexWord16Array# ba# i#) + +newByteArray :: Int -> ST s (MBA s) +newByteArray (I# len#) = + ST $ \s -> case newByteArray# len# s of + (# s', mba# #) -> (# s', MBA# mba# #) + +unsafeFreezeByteArray :: MBA s -> ST s BA +unsafeFreezeByteArray (MBA# mba#) = + ST $ \s -> case unsafeFreezeByteArray# mba# s of + (# s', ba# #) -> (# s', BA# ba# #) diff --git a/lib/Data/Word16.hs b/lib/Data/Word16.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Word16.hs @@ -0,0 +1,279 @@ +-- | Word16 module to be used with ByteString/ShortByteString. +-- All functions assumes that 'Word16' is encoded in BE. +module Data.Word16 ( + -- * Re-exporting + Word16 + -- * conversion + , word16ToChar + , charToWord16 + -- * Character classification + , isControl, isSpace, isLower, isUpper + , isAlpha, isAlphaNum, isPrint, isDigit, isOctDigit, isHexDigit + , isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator + -- * Subranges + , isAscii, isLatin1, isAsciiUpper, isAsciiLower + -- * Case conversion + , toUpper, toLower, toTitle + -- * ASCII characters + , _nul, _tab, _lf, _vt, _np, _cr + , _space, _exclam, _quotedbl, _numbersign, _dollar, _percent, _ampersand, _quotesingle, _parenleft, _parenright, _asterisk, _plus, _comma, _hyphen, _period, _slash + , _0, _1, _2, _3, _4, _5, _6, _7, _8, _9 + , _colon, _semicolon, _less, _equal, _greater, _question, _at + , _A, _B, _C, _D, _E, _F, _G, _H, _I, _J, _K, _L, _M, _N, _O, _P, _Q, _R, _S, _T, _U, _V, _W, _X, _Y, _Z + , _bracketleft, _backslash, _bracketright, _circum, _underscore, _grave + , _a, _b, _c, _d, _e, _f, _g, _h, _i, _j, _k, _l, _m, _n, _o, _p, _q, _r, _s, _t, _u, _v, _w, _x, _y, _z + , _braceleft, _bar, _braceright, _tilde, _del + -- * Some Latin-1 characters + , _nbsp + , _ordfeminine, _softhyphen, _mu, _ordmasculine + , _s2, _s3, _s1, _1'4, _1'2, _3'4 + , _Agrave, _Odieresis, _Oslash, _Thorn + , _germandbls, _agrave, _odieresis, _oslash, _thorn, _ydieresis + ) where + +import qualified Data.Char as C +import Data.Word + ( Word16 ) + + +---------------------------------------------------------------- + +-- | Total conversion to char. +word16ToChar :: Word16 -> Char +word16ToChar = C.chr . fromIntegral + +-- | This is unsafe and clamps at Word16 maxbound. +charToWord16 :: Char -> Word16 +charToWord16 = fromIntegral . C.ord + +---------------------------------------------------------------- + +isControl :: Word16 -> Bool +isControl w = _nul <= w && w <= 0x1f + || _del <= w && w <= 0x9f + +isSpace :: Word16 -> Bool +isSpace = C.isSpace . word16ToChar + +isLower :: Word16 -> Bool +isLower = C.isLower . word16ToChar + +isUpper :: Word16 -> Bool +isUpper = C.isUpper . word16ToChar + +isAlpha :: Word16 -> Bool +isAlpha = C.isAlpha . word16ToChar + +isAlphaNum :: Word16 -> Bool +isAlphaNum = C.isAlphaNum . word16ToChar + +isPrint :: Word16 -> Bool +isPrint = C.isPrint . word16ToChar + +isDigit :: Word16 -> Bool +isDigit w = _0 <= w && w <= _9 + +isOctDigit :: Word16 -> Bool +isOctDigit w = _0 <= w && w <= _7 + +isHexDigit :: Word16 -> Bool +isHexDigit w = isDigit w + || _A <= w && w <= _F + || _a <= w && w <= _f + +isLetter :: Word16 -> Bool +isLetter = C.isLetter . word16ToChar + +isMark :: Word16 -> Bool +isMark = C.isMark . word16ToChar + +isNumber :: Word16 -> Bool +isNumber = C.isNumber . word16ToChar + +isPunctuation :: Word16 -> Bool +isPunctuation = C.isPunctuation . word16ToChar + +isSymbol :: Word16 -> Bool +isSymbol = C.isSymbol . word16ToChar + +isSeparator :: Word16 -> Bool +isSeparator = C.isSeparator . word16ToChar + +---------------------------------------------------------------- + +isAscii :: Word16 -> Bool +isAscii w = _nul <= w && w <= _del + +isLatin1 :: Word16 -> Bool +isLatin1 = C.isLatin1 . word16ToChar + +isAsciiUpper :: Word16 -> Bool +isAsciiUpper w = _A <= w && w <= _Z + +isAsciiLower :: Word16 -> Bool +isAsciiLower w = _a <= w && w <= _z + +---------------------------------------------------------------- + +toUpper :: Word16 -> Word16 +-- charToWord16 should be safe here, since C.toUpper doesn't go beyond Word16 maxbound +toUpper = charToWord16 . C.toUpper . word16ToChar + +toLower :: Word16 -> Word16 +-- charToWord16 should be safe here, since C.toLower doesn't go beyond Word16 maxbound +toLower = charToWord16 . C.toLower . word16ToChar + +toTitle :: Word16 -> Word16 +toTitle = toUpper + +---------------------------------------------------------------- + +_nul, _tab, _lf, _vt, _np, _cr :: Word16 +_nul = 0x00 +_tab = 0x09 +_lf = 0x0a +_vt = 0x0b +_np = 0x0c +_cr = 0x0d + +_space, _exclam, _quotedbl, _numbersign, _dollar, _percent, _ampersand, _quotesingle, _parenleft, _parenright, _asterisk, _plus, _comma, _hyphen, _period, _slash :: Word16 +_space = 0x20 +_exclam = 0x21 +_quotedbl = 0x22 +_numbersign = 0x23 +_dollar = 0x24 +_percent = 0x25 +_ampersand = 0x26 +_quotesingle = 0x27 +_parenleft = 0x28 +_parenright = 0x29 +_asterisk = 0x2a +_plus = 0x2b +_comma = 0x2c +_hyphen = 0x2d +_period = 0x2e +_slash = 0x2f + +_0, _1, _2, _3, _4, _5, _6, _7, _8, _9 :: Word16 +_0 = 0x30 +_1 = 0x31 +_2 = 0x32 +_3 = 0x33 +_4 = 0x34 +_5 = 0x35 +_6 = 0x36 +_7 = 0x37 +_8 = 0x38 +_9 = 0x39 + +_colon, _semicolon, _less, _equal, _greater, _question, _at :: Word16 +_colon = 0x3a +_semicolon = 0x3b +_less = 0x3c +_equal = 0x3d +_greater = 0x3e +_question = 0x3f +_at = 0x40 + +_A, _B, _C, _D, _E, _F, _G, _H, _I, _J, _K, _L, _M, _N, _O, _P, _Q, _R, _S, _T, _U, _V, _W, _X, _Y, _Z :: Word16 +_A = 0x41 +_B = 0x42 +_C = 0x43 +_D = 0x44 +_E = 0x45 +_F = 0x46 +_G = 0x47 +_H = 0x48 +_I = 0x49 +_J = 0x4a +_K = 0x4b +_L = 0x4c +_M = 0x4d +_N = 0x4e +_O = 0x4f +_P = 0x50 +_Q = 0x51 +_R = 0x52 +_S = 0x53 +_T = 0x54 +_U = 0x55 +_V = 0x56 +_W = 0x57 +_X = 0x58 +_Y = 0x59 +_Z = 0x5a + +_bracketleft, _backslash, _bracketright, _circum, _underscore, _grave :: Word16 +_bracketleft = 0x5b +_backslash = 0x5c +_bracketright = 0x5d +_circum = 0x5e +_underscore = 0x5f +_grave = 0x60 + +_a, _b, _c, _d, _e, _f, _g, _h, _i, _j, _k, _l, _m, _n, _o, _p, _q, _r, _s, _t, _u, _v, _w, _x, _y, _z :: Word16 +_a = 0x61 +_b = 0x62 +_c = 0x63 +_d = 0x64 +_e = 0x65 +_f = 0x66 +_g = 0x67 +_h = 0x68 +_i = 0x69 +_j = 0x6a +_k = 0x6b +_l = 0x6c +_m = 0x6d +_n = 0x6e +_o = 0x6f +_p = 0x70 +_q = 0x71 +_r = 0x72 +_s = 0x73 +_t = 0x74 +_u = 0x75 +_v = 0x76 +_w = 0x77 +_x = 0x78 +_y = 0x79 +_z = 0x7a + +_braceleft, _bar, _braceright, _tilde, _del :: Word16 +_braceleft = 0x7b +_bar = 0x7c +_braceright = 0x7d +_tilde = 0x7e +_del = 0x7f + +_nbsp :: Word16 +_nbsp = 0xa0 + +_ordfeminine, _softhyphen, _mu, _ordmasculine :: Word16 +_ordfeminine = 0xaa +_softhyphen = 0xad +_mu = 0xb5 +_ordmasculine = 0xba + +_s2, _s3, _s1, _1'4, _1'2, _3'4 :: Word16 +_s2 = 0xb2 +_s3 = 0xb3 +_s1 = 0xb9 +_1'4 = 0xbc +_1'2 = 0xbd +_3'4 = 0xbe + +_Agrave, _Odieresis, _Oslash, _Thorn :: Word16 +_Agrave = 0xc0 +_Odieresis = 0xd6 +_Oslash = 0xd8 +_Thorn = 0xde + +_germandbls, _agrave, _odieresis, _oslash, _thorn, _ydieresis :: Word16 +_germandbls = 0xdf +_agrave = 0xe0 +_odieresis = 0xf6 +_oslash = 0xf8 +_thorn = 0xfe +_ydieresis = 0xff + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Word16Spec.hs b/test/Word16Spec.hs new file mode 100644 --- /dev/null +++ b/test/Word16Spec.hs @@ -0,0 +1,113 @@ +module Word16Spec where + +import qualified Data.Char as C +import Data.Word16 +import Test.Hspec +import Test.Hspec.QuickCheck + +spec :: Spec +spec = do + describe "isControl" $ do + prop "behaves like model" $ \w -> + isControl w == C.isControl (word16ToChar w) + + describe "isSpace" $ do + prop "behaves like model" $ \w -> + isSpace w == C.isSpace (word16ToChar w) + + describe "isLower" $ do + prop "behaves like model" $ \w -> + isLower w == C.isLower (word16ToChar w) + + describe "isUpper" $ do + prop "behaves like model" $ \w -> + isUpper w == C.isUpper (word16ToChar w) + + describe "isAlpha" $ do + prop "behaves like model" $ \w -> + isAlpha w == C.isAlpha (word16ToChar w) + + describe "isAlphaNum" $ do + prop "behaves like model" $ \w -> + isAlphaNum w == C.isAlphaNum (word16ToChar w) + + describe "isPrint" $ do + prop "behaves like model" $ \w -> + isPrint w == C.isPrint (word16ToChar w) + + describe "isDigit" $ do + prop "behaves like model" $ \w -> + isDigit w == C.isDigit (word16ToChar w) + + describe "isOctDigit" $ do + prop "behaves like model" $ \w -> + isOctDigit w == C.isOctDigit (word16ToChar w) + + describe "isHexDigit" $ do + prop "behaves like model" $ \w -> + isHexDigit w == C.isHexDigit (word16ToChar w) + + describe "isLetter" $ do + prop "behaves like model" $ \w -> + isLetter w == C.isLetter (word16ToChar w) + + describe "isMark" $ do + prop "behaves like model" $ \w -> + isMark w == C.isMark (word16ToChar w) + + describe "isNumber" $ do + prop "behaves like model" $ \w -> + isNumber w == C.isNumber (word16ToChar w) + + describe "isPunctuation" $ do + prop "behaves like model" $ \w -> + isPunctuation w == C.isPunctuation (word16ToChar w) + + describe "isSymbol" $ do + prop "behaves like model" $ \w -> + isSymbol w == C.isSymbol (word16ToChar w) + + describe "isSeparator" $ do + prop "behaves like model" $ \w -> + isSeparator w == C.isSeparator (word16ToChar w) + + describe "isAscii" $ do + prop "behaves like model" $ \w -> + isAscii w == C.isAscii (word16ToChar w) + + describe "isLatin1" $ do + prop "behaves like model" $ \w -> + isLatin1 w == C.isLatin1 (word16ToChar w) + + describe "isAsciiUpper" $ do + prop "behaves like model" $ \w -> + isAsciiUpper w == C.isAsciiUpper (word16ToChar w) + + describe "isAsciiLower" $ do + prop "behaves like model" $ \w -> + isAsciiLower w == C.isAsciiLower (word16ToChar w) + + describe "toUpper" $ do + prop "behaves like model" $ prop_toUpper + + describe "toLower" $ do + prop "behaves like model" $ \w -> + word16ToChar (toLower w) == C.toLower (word16ToChar w) + + describe "toTitle" $ do + prop "behaves like model" $ prop_toTitle + +prop_toUpper :: Word16 -> Bool +prop_toUpper w + | w == _mu = True + | w >= _ydieresis = True + | otherwise = word16ToChar (toUpper w) == C.toUpper (word16ToChar w) + +prop_toTitle :: Word16 -> Bool +prop_toTitle w + | w == _mu = True + | w >= _ydieresis = True + | otherwise = word16ToChar (toTitle w) == C.toTitle (word16ToChar w) + +---------------------------------------------------------------- + diff --git a/word16.cabal b/word16.cabal new file mode 100644 --- /dev/null +++ b/word16.cabal @@ -0,0 +1,62 @@ +cabal-version: 1.24 +name: word16 +version: 0.1.0.0 +license: MIT +license-file: LICENSE +maintainer: hasufell@posteo.de +author: Julian Ospald +synopsis: Word16 library +description: + Word16 (rather Word16BE) library useful for dealing with Windows UTF-16LE ByteString/ShortByteString. + +build-type: Simple +tested-with: + GHC ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.6 + || ==9.0.1 + +category: System +extra-doc-files: CHANGELOG.md + +library + exposed-modules: Data.Word16 + hs-source-dirs: lib + default-language: Haskell2010 + build-depends: + base >=4.9.1.0 && <5 + , bytestring >=0.10 && <0.12 + , template-haskell >=2.10 && <2.20 + , text >=1.2.2.0 && <1.2.6 + +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall + main-is: Spec.hs + other-modules: Word16Spec + build-tool-depends: hspec-discover:hspec-discover -any + build-depends: + base >=4.9.1.0 && <5 + , hspec + , word16 + +benchmark criterion + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + ghc-options: -Wall + main-is: Bench.hs + build-depends: + base >=4.9.1.0 && <5 + , bytestring >=0.10 && <0.12 + , criterion >=1.1 && <1.6 + , word16 + +source-repository head + type: git + location: https://github.com/hasufell/word16.git