os-string-compat (empty) → 1.0.1
raw patch · 29 files changed
+3897/−0 lines, 29 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, deepseq, exceptions, filepath, os-string, os-string-compat, quickcheck-classes-base, random, tasty-bench
Files
- CHANGELOG.md +38/−0
- LICENSE +33/−0
- README.md +140/−0
- Setup.hs +2/−0
- bench/Bench.hs +16/−0
- bench/BenchOsString.hs +45/−0
- bench/BenchPosixString.hs +34/−0
- bench/BenchWindowsString.hs +34/−0
- os-string-compat.cabal +174/−0
- src/System/OsString/Compat.hs +140/−0
- src/System/OsString/Encoding/Compat.hs +38/−0
- src/System/OsString/Encoding/Internal/Compat.hs +158/−0
- src/System/OsString/Internal/Compat.hs +736/−0
- src/System/OsString/Internal/Exception/Compat.hs +34/−0
- src/System/OsString/Internal/Types/Compat.hs +65/−0
- src/System/OsString/Posix/Compat.hs +13/−0
- src/System/OsString/Windows/Compat.hs +19/−0
- src/System/OsString/include/Common.hs +1171/−0
- test/Arbitrary.hs +71/−0
- test/TestUtil.hs +51/−0
- test/bytestring/Properties/OsString.hs +6/−0
- test/bytestring/Properties/PosixString.hs +6/−0
- test/bytestring/Properties/ShortByteString.hs +6/−0
- test/bytestring/Properties/ShortByteString/Word16.hs +6/−0
- test/bytestring/Properties/WindowsString.hs +6/−0
- test/bytestring/Properties/include/Common.hs +653/−0
- test/bytestring/Spec.hs +13/−0
- test/encoding/EncodingSpec.hs +180/−0
- test/encoding/Spec.hs +9/−0
+ CHANGELOG.md view
@@ -0,0 +1,38 @@+# Changelog for `os-string-compat`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [1.0.1] - 2025-11-22++First actual release.++### Fixed++- Fixed lower bound on base+- Fixed lower bounds on dependencies for tests+- Tested with more versions of GHC on macOS+- Fixed some documentation to work with more versions of Haddock++## [1.0.0] - 2025-11-11++This was originally supposed to be the first actual release,+but I wound up changing some things, but the changelog on+Hackage wouldn't update. So I just decided to bump to version+1.0.1.++### Added++- Added proper tests and benchmarks.+- Added equivalent functions to those in `os-string`.++## Pre-Release - 2025-10-26++### Changed++- Created the repository.+- First (public) "release".+- Added an actual readme.
+ LICENSE view
@@ -0,0 +1,33 @@+BSD 3-Clause License + +Copyright (c) Neil Mitchell, 2005-2020 +All rights reserved + +Copyright (c) Julian Ospald, 2021-2025 + +Copyright (c) David Wilson, 2025 + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the copyright holder nor the names of its + 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 HOLDER 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.
+ README.md view
@@ -0,0 +1,140 @@+# os-string-compat++[](https://github.com/Anteproperispomenon/os-string-compat/actions/workflows/haskell.yml)+[](https://github.com/Anteproperispomenon/os-string-compat/actions/workflows/haskell_cabal.yml)++## Note on Hackage++I haven't been able to get Stack/Cabal to generate versions of the documentation that+properly link to entities from other packages on Hackage. Unfortunately, this means+that you won't see documentation for functions that are just included directly from+other packages, and you won't see links to their source code. To (partially) get around this,+I ran Haddock while Stack was using an older version of [filepath](https://hackage.haskell.org/package/filepath)+so that there would be more visible definitions. Hopefully this will improve the+documentation.++If you want proper documentation of functions (and types), I recommend just checking out+[os-string](https://hackage.haskell.org/package/os-string), since it shouldn't have+that problem.++This may be because I'm trying to compile the documentation on Windows. I might try+at some point to auto-generate the docs with GitHub Actions... once I understand how+to do that.++## Note on macOS++This package may not work with older versions of GHC on macOS; when testing GHC 8.10.1+on macOS on GitHub Actions, it failed to install GHC. This seens to be because ARM support+for mac wasn't added until GHC 8.10.4 (and improved thereafter). To reflect this, macOS is+tested on the oldest version of GHC that still successfully installs on GitHub.++Currently, the oldest version of GHC that is able to compile this package on macOS is `9.2.8`.++## Intro and Purpose++This is a compatibility layer over [os-string](https://hackage.haskell.org/package/os-string)+and (older versions of) [filepath](https://hackage.haskell.org/package/filepath). Notably,+in versions `1.4.100 <= v < 1.5` of `filepath`, the `newtype` `OsString` was defined in+the `filepath` package itself. However, you *can* import these versions of `filepath`+alongside `os-string`, which *also* defines a `newtype` `OsString`. In fact, in versions+`1.4.200` onwards of `filepath` it *recommends* importing `OsString` via `os-string`+instead of via `filepath`.++The problem is, you can't use functions from `os-string` on `OsString`s from `filepath`.+This may not seem like a problem at first, but `os-string` adds *a lot* of functions for+working directly on `OsString`s.+This isn't a problem if you have a version of `filepath` that's newer than `1.5`, but some+packages *require* that `filepath` be older than `1.5`. If you're writing a package that+depends on such a package, you can't use any of the new functions from `os-string` directly.++Fortunately, in both `os-string` and older versions of `filepath`, `OsString` is ultimately+just a `newtype` over `ShortByteString`[^1], so you can coerce between the two definitions of +`OsString`[^2]. That's what this package does: it exposes new versions of functions from+`os-string` that are just coerced to work on `OsString`/`OsPath` from `1.4.100+`.++Note that this package works for both pre-1.5 versions of `filepath` *and* post-1.5 versions+of `filepath`. On newer versions, it just re-exports the functions[^3] from `os-string`, since+`filepath` 1.5+ depends on `os-string`. Therefore, you can import `os-string-compat` instead+of `os-string` and you can use the functions regardless of which version of `filepath` you+have. If you're writing a library, you may want to depend on `os-string-compat` instead of+`os-string`, since it'll enable you to put more lenient bounds on `filepath`.++## Usage++### Stack++If this package still isn't available on Hackage (i.e. if the link +<https://hackage.haskell.org/package/os-string-compat> doesn't lead to+a valid package), you'll have to import this package by adding it to+your `stack.yaml` file. You'll also have to do this if you want to+use an exact *revision* of the package.+e.g.++```yaml+extra-deps:+- git: https://github.com/Anteproperispomenon/os-string-compat+ commit: 3ea425f103d2f14e3f9f7f713eb4291fee5b38a4 # keep this up-to-date+```++If this package **is** available on Hackage, you may still have to add+it to the `extra-deps` field in `stack.yaml`, but you won't have to +give an exact commit. You can just say e.g.++```yaml+extra-deps:+- os-string-compat-1.0.1+```++### Cabal++If this package has been added to Hackage, you should be able+to run `cabal update` and then add `os-string-compat >= 1.0.1`+to the `build-depends` field in your `<package_name>.cabal` file.++If it still isn't available on Hackage, then you'll have to+add it to your `cabal.project` file. I haven't used this feature+myself, but it'll probably be something like this:++```+packages: .++source-repository-package+ type: git+ location: https://github.com/Anteproperispomenon/os-string-compat+ tag: 3ea425f103d2f14e3f9f7f713eb4291fee5b38a4+```++(See [cabal docs](https://cabal.readthedocs.io/en/3.4/cabal-project.html)+ for more info)++### Using the Modules++After that, instead of importing `System.OsString` etc, you import `System.OsString.Compat`+etc... That is, you use the same module name, but add `.Compat` to the end. Note that this+package doesn't include compatibility modules for `System.OsString.Data.ByteString.Short` or+`System.OsString.Data.ByteString.Short.Word16`, since you can just import them directly+without needing to worry about compatibility with `filepath`; when they were included+in `filepath`, they were known as "System.Os*Path*.Data.ByteString.Short" etc..., so their+module names won't clash.++## To-Do++Possibly add more versions of GHC to GitHub Actions workflows. Also look into how to+use GitHub Actions to automate building documentation/packages for Hackage. Also,+figure out how to cache dependencies for the Stack workflow.++## Footnotes++[^1]: Which is itself a `newtype` over `ByteArray`.+[^2]: Yes, there is a difference between Windows `OsString` and POSIX `OsString`,+ but so long as you coerce from `WindowsString` to `WindowsString` or + `PosixString` to `PosixString`, you should be okay.+[^3]: There are a few functions that have different definitions depending on the+ version of `os-string`, or only exist in newer versions of `os-string`.+ For the former, such as `length`, this package exports its own version+ based on newer versions of `length` from `os-string`. That way, its+ behaviour is not dependent on the version of `os-string` used. For the+ latter, more obscure functions just aren't exported if the version of+ `os-string` isn't new enough, while others (especially functions that+ the test suites rely on) are defined here, with their definitions just+ copied from newer versions of `os-string`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,16 @@+-- Taken from os-string + +module Main (main) where + +import Test.Tasty.Bench +import qualified BenchOsString +import qualified BenchPosixString +import qualified BenchWindowsString + + +main :: IO () +main = do + defaultMain [ BenchOsString.benchMark + , BenchPosixString.benchMark + , BenchWindowsString.benchMark + ]
+ bench/BenchOsString.hs view
@@ -0,0 +1,45 @@+-- taken from os-string + +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + +#define OSSTR osstr +#define OS_STRING OsString +#define OS_CHAR OsChar + +module BenchOsString (benchMark) where + +import Data.Type.Coercion (coerceWith, sym) +import System.OsString.Compat (osstr) +import System.OsString.Compat qualified as S +import System.OsString.Internal.Types.Compat (OsString(..), OsChar(..), PosixChar(..), WindowsChar(..)) + +#include "include/Common.hs" + +benchStr :: String +benchStr = "OsString" + +w :: Int -> OsChar +w = case S.coercionToPlatformTypes of + Left (co, _) -> coerceWith (sym co) . WindowsChar . fromIntegral + Right (co, _) -> coerceWith (sym co) . PosixChar . fromIntegral + +hashWord8 :: OsChar -> OsChar +hashWord8 = case S.coercionToPlatformTypes of + Left (co, _) -> + coerceWith (sym co) . WindowsChar . fromIntegral . hashInt . fromIntegral . + getWindowsChar . coerceWith co + Right (co, _) -> + coerceWith (sym co) . PosixChar . fromIntegral . hashInt . fromIntegral . + getPosixChar . coerceWith co + +iw :: OsChar -> Int +iw = case S.coercionToPlatformTypes of + Left (co, _) -> fromIntegral . getWindowsChar . coerceWith co + Right (co, _) -> fromIntegral . getPosixChar . coerceWith co
+ bench/BenchPosixString.hs view
@@ -0,0 +1,34 @@+-- taken from os-string + +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + +#define OSSTR pstr +#define OS_STRING PosixString +#define OS_CHAR PosixChar + +module BenchPosixString (benchMark) where + +import System.OsString.Posix.Compat (PosixString, pstr) +import System.OsString.Posix.Compat qualified as S +import System.OsString.Internal.Types.Compat (PosixChar(..)) + +#include "include/Common.hs" + +benchStr :: String +benchStr = "PosixString" + +w :: Int -> PosixChar +w i = PosixChar (fromIntegral i) + +hashWord8 :: PosixChar -> PosixChar +hashWord8 (PosixChar w) = PosixChar . fromIntegral . hashInt . fromIntegral $ w + +iw :: PosixChar -> Int +iw (PosixChar w) = fromIntegral w
+ bench/BenchWindowsString.hs view
@@ -0,0 +1,34 @@+-- taken from os-string + +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + +#define OSSTR pstr +#define OS_STRING WindowsString +#define OS_CHAR WindowsChar + +module BenchWindowsString (benchMark) where + +import System.OsString.Windows.Compat (WindowsString, WindowsChar, pstr) +import System.OsString.Windows.Compat qualified as S +import System.OsString.Internal.Types.Compat (WindowsChar(..)) + +#include "include/Common.hs" + +benchStr :: String +benchStr = "WindowsString" + +w :: Int -> WindowsChar +w i = WindowsChar (fromIntegral i) + +hashWord8 :: WindowsChar -> WindowsChar +hashWord8 (WindowsChar w) = WindowsChar . fromIntegral . hashInt . fromIntegral $ w + +iw :: WindowsChar -> Int +iw (WindowsChar w) = fromIntegral w
+ os-string-compat.cabal view
@@ -0,0 +1,174 @@+cabal-version: 2.2 ++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name: os-string-compat+version: 1.0.1+synopsis: Compatibility layer for os-string+description: Please see the README on GitHub at <https://github.com/Anteproperispomenon/os-string-compat#readme>+category: System+homepage: https://github.com/Anteproperispomenon/os-string-compat#readme+bug-reports: https://github.com/Anteproperispomenon/os-string-compat/issues+author: David Wilson+maintainer: David Wilson+copyright: 2025 David Wilson+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+tested-with:+ GHC == 9.2.8 || == 9.8.4 || == 9.10.3 || == 9.12.2 || == 8.10.1+extra-source-files:+ README.md+ src/System/OsString/include/Common.hs+ test/bytestring/Properties/include/Common.hs+ CHANGELOG.md+extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/Anteproperispomenon/os-string-compat++library+ exposed-modules:+ System.OsString.Compat+ System.OsString.Encoding.Compat+ System.OsString.Encoding.Internal.Compat+ System.OsString.Internal.Compat+ System.OsString.Internal.Exception.Compat+ System.OsString.Internal.Types.Compat+ System.OsString.Posix.Compat+ System.OsString.Windows.Compat+ other-modules:+ Paths_os_string_compat+ autogen-modules:+ Paths_os_string_compat+ hs-source-dirs:+ src+ default-extensions:+ ImportQualifiedPost+ LambdaCase+ MultiWayIf+ OverloadedStrings+ PackageImports+ ScopedTypeVariables+ TupleSections+ TypeApplications+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ base >=4.14 && <4.23+ , bytestring >=0.11.3.0 && <0.13+ , exceptions >=0.10.5 && <0.12+ , filepath >=1.4.101.0 && <=1.6+ , os-string >=2.0.1 && <=2.1+ default-language: Haskell2010++test-suite bytestring-tests+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Arbitrary+ TestUtil+ Properties.OsString+ Properties.PosixString+ Properties.ShortByteString+ Properties.ShortByteString.Word16+ Properties.WindowsString+ Paths_os_string_compat+ autogen-modules:+ Paths_os_string_compat+ hs-source-dirs:+ test+ test/bytestring+ default-extensions:+ ImportQualifiedPost+ LambdaCase+ MultiWayIf+ OverloadedStrings+ PackageImports+ ScopedTypeVariables+ TupleSections+ TypeApplications+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.7 && <2.20+ , base >=4.14 && <4.23+ , bytestring >=0.11.3.0 && <0.13+ , exceptions >=0.10.5 && <0.12+ , filepath >=1.4.101.0 && <=1.6+ , os-string >=2.0.1 && <=2.1+ , os-string-compat+ default-language: Haskell2010++test-suite encoding-tests+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Arbitrary+ TestUtil+ EncodingSpec+ Paths_os_string_compat+ autogen-modules:+ Paths_os_string_compat+ hs-source-dirs:+ test+ test/encoding+ default-extensions:+ ImportQualifiedPost+ LambdaCase+ MultiWayIf+ OverloadedStrings+ PackageImports+ ScopedTypeVariables+ TupleSections+ TypeApplications+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.7 && <2.20+ , base >=4.14 && <4.23+ , bytestring >=0.11.3.0+ , deepseq >=1.4.4 && <1.6+ , exceptions >=0.10.5 && <0.12+ , filepath >=1.4.101.0 && <=1.6+ , os-string >=2.0.1 && <=2.1+ , os-string-compat+ , quickcheck-classes-base >=0.6.2 && <0.7+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ other-modules:+ BenchOsString+ BenchPosixString+ BenchWindowsString+ Paths_os_string_compat+ autogen-modules:+ Paths_os_string_compat+ hs-source-dirs:+ bench+ default-extensions:+ ImportQualifiedPost+ LambdaCase+ MultiWayIf+ OverloadedStrings+ PackageImports+ ScopedTypeVariables+ TupleSections+ TypeApplications+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2 -with-rtsopts=-A32m+ build-depends:+ base >=4.14 && <4.23+ , bytestring >=0.11.3.0 && <0.13+ , deepseq >=1.4.4 && <1.6+ , exceptions >=0.10.5 && <0.12+ , filepath >=1.4.101.0 && <=1.6+ , os-string >=2.0.1 && <=2.1+ , os-string-compat+ , random >=1.2.1.3 && <1.4+ , tasty-bench ==0.4.*+ default-language: Haskell2010+ if impl(ghc >= 8.6)+ ghc-options: -fproc-alignment=64
+ src/System/OsString/Compat.hs view
@@ -0,0 +1,140 @@+{-| +Module : System.OsString.Compat +Copyright : (c) 2021 Julian Ospald, 2025 David Wilson +License : BSD-3-Clause (see the LICENSE file) + +Compatibility layer for versions of filepath that +don't import os-string. For versions that do, it +just re-exports the corresponding functions from +"System.OsString". + +Note: All documentation is taken from the os-string +documentation, except for a few functions/types that +are found in the older versions of "filepath". + +For more information on `OsString`s in general, look +at the package [os-string](https://hackage.haskell.org/package/os-string). + +-} + +module System.OsString.Compat + ( + -- * String types + OsString + + -- * OsString construction + , encodeUtf + , unsafeEncodeUtf + , encodeWith + , encodeFS + , osstr + , empty + , singleton + , pack + + -- * OsString deconstruction + , decodeUtf + , decodeWith + , decodeFS + , unpack + + -- * Word types + , OsChar + + -- * Word construction + , unsafeFromChar + + -- * Word deconstruction + , toChar + + -- * Basic interface + , snoc + , cons + , last + , tail + , uncons + , head + , init + , unsnoc + , null + , length + , lengthBytes + + -- * Transforming OsString + , map + , reverse + , intercalate + + -- * Reducing OsStrings (folds) + , foldl + , foldl' + , foldl1 + , foldl1' + , foldr + , foldr' + , foldr1 + , foldr1' + + -- * Special folds + , all + , any + , concat + + -- * Generating and unfolding OsStrings + , replicate + , unfoldr + , unfoldrN + + -- * Substrings + -- ** Breaking strings + , take + , takeEnd + , takeWhileEnd + , takeWhile + , drop + , dropEnd + , dropWhileEnd + , dropWhile + , break + , breakEnd + , span + , spanEnd + , splitAt + , split + , splitWith + , stripSuffix + , stripPrefix + + -- * Predicates + , isInfixOf + , isPrefixOf + , isSuffixOf + -- ** Search for arbitrary susbstrings + , breakSubstring + + -- * Searching OsStrings + -- ** Searching by equality + , elem + , find + , filter + , partition + + -- * Indexing OsStrings + , index + , indexMaybe + , (!?) + , elemIndex + , elemIndices + , count + , findIndex + , findIndices + + -- * Coercions + , coercionToPlatformTypes + ) where + +import Prelude () + +import System.OsString.Internal.Compat +import System.OsString.Internal.Types.Compat +
+ src/System/OsString/Encoding/Compat.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-} + +module System.OsString.Encoding.Compat + ( + -- * Types + EncodingException(..) + , showEncodingException + + -- * UCS-2 + , ucs2le + , mkUcs2le + , ucs2le_DF + , ucs2le_EF + , ucs2le_decode + , ucs2le_encode + + -- * UTF-16LE_b + , utf16le_b + , mkUTF16le_b + , utf16le_b_DF + , utf16le_b_EF + , utf16le_b_decode + , utf16le_b_encode + + -- * base encoding + , encodeWithBasePosix + , decodeWithBasePosix +#if MIN_VERSION_os_string(2,0,5) + , encodeWithBasePosix' + , decodeWithBasePosix' +#endif + , encodeWithBaseWindows + , decodeWithBaseWindows + ) + where + +import System.OsString.Encoding.Internal.Compat +
+ src/System/OsString/Encoding/Internal/Compat.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE CPP #-} + +module System.OsString.Encoding.Internal.Compat + ( ucs2le + , mkUcs2le + , ucs2le_DF + , ucs2le_EF + , ucs2le_decode + , ucs2le_encode + , utf16le_b + , mkUTF16le_b + , utf16le_b_DF + , utf16le_b_EF + , utf16le_b_decode + , utf16le_b_encode + , cWcharsToChars_UCS2 + , cWcharsToChars + , charsToCWchars + , withWindowsString + , withFilePathWin + , peekWindowsString + , peekFilePathWin + , withPosixString + , withFilePathPosix +#if MIN_VERSION_os_string(2,0,5) + , withPosixString' + , withFilePathPosix' +#endif + , peekPosixString +#if MIN_VERSION_os_string(2,0,5) + , peekPosixString' +#endif + , peekFilePathPosix +#if MIN_VERSION_os_string(2,0,5) + , peekFilePathPosix' +#endif + , decodeWithTE + , encodeWithTE + , decodeWithBasePosix +#if MIN_VERSION_os_string(2,0,5) + , decodeWithBasePosix' +#endif + , encodeWithBasePosix +#if MIN_VERSION_os_string(2,0,5) + , encodeWithBasePosix' +#endif + , decodeWithBaseWindows + , encodeWithBaseWindows + , EncodingException(..) + , showEncodingException + , wNUL + ) where + +import GHC.Ptr +import Data.Word +import Foreign.C.String + +#if MIN_VERSION_filepath(1,5,0) + +import "os-string" System.OsString.Encoding.Internal + +-- | Synonym of `withWindowsString` +withFilePathWin :: FilePath -> (Int -> Ptr Word16 -> IO a) -> IO a +withFilePathWin = withWindowsString +{-# INLINE withFilePathWin #-} + +-- | Synonym of `peekWindowsString` +peekFilePathWin :: (Ptr Word16, Int) -> IO FilePath +peekFilePathWin = peekWindowsString +{-# INLINE peekFilePathWin #-} + +-- | Synonym of `withPosixString` +withFilePathPosix :: FilePath -> (CStringLen -> IO a) -> IO a +withFilePathPosix = withPosixString +{-# INLINE withFilePathPosix #-} + +# if MIN_VERSION_os_string(2,0,5) +-- | Synonym of `withPosixString'` +withFilePathPosix' :: FilePath -> (CStringLen -> IO a) -> IO a +withFilePathPosix' = withPosixString' +{-# INLINE withFilePathPosix' #-} + +peekFilePathPosix' :: CStringLen -> IO String +peekFilePathPosix' = peekPosixString' +{-# INLINE peekFilePathPosix' #-} +# endif + +peekFilePathPosix :: CStringLen -> IO String +peekFilePathPosix = peekPosixString +{-# INLINE peekFilePathPosix #-} + +-- ---------------------------------------------------------------- -- +-- ---------------------------------------------------------------- -- +-- ---------------------------------------------------------------- -- + +#else + +import "filepath" System.OsPath.Encoding.Internal + +import "os-string" System.OsString.Encoding.Internal qualified as New + +import Data.ByteString.Short (ShortByteString) + +-- import GHC.IO.Encoding (getFileSystemEncoding, getLocaleEncoding) +-- import GHC.Foreign qualified as GHC + +-- | Synonym of `withFilePathWin` +withWindowsString :: String -> (Int -> Ptr Word16 -> IO a) -> IO a +withWindowsString = withFilePathWin +{-# INLINE withWindowsString #-} + +-- | Synonym of `peekFilePathWin`. +peekWindowsString :: (Ptr Word16, Int) -> IO FilePath +peekWindowsString = peekFilePathWin +{-# INLINE peekWindowsString #-} + +-- | Synonym of `withFilePathPosix` +withPosixString :: FilePath -> (CStringLen -> IO a) -> IO a +withPosixString = withFilePathPosix +{-# INLINE withPosixString #-} + +# if MIN_VERSION_os_string(2,0,5) +-- | Alternate version of `withPosixString` from +-- newer versions of os-string. +withPosixString' :: String -> (CStringLen -> IO a) -> IO a +withPosixString'= New.withPosixString' + +-- | Synonym of `withPosixString'`. +withFilePathPosix' :: String -> (CStringLen -> IO a) -> IO a +withFilePathPosix' = withPosixString' +{-# INLINE withFilePathPosix' #-} +# endif + +peekPosixString :: CStringLen -> IO String +peekPosixString = peekFilePathPosix +{-# INLINE peekPosixString #-} + +# if MIN_VERSION_os_string(2,0,5) +-- may need to re-write this and other +-- -' functions to be based on the original +-- code. +peekFilePathPosix' :: CStringLen -> IO String +peekFilePathPosix' = New.peekPosixString' + +peekPosixString' :: CStringLen -> IO String +peekPosixString' = New.peekPosixString' +{-# INLINE peekPosixString' #-} + +decodeWithBasePosix' :: ShortByteString -> IO String +decodeWithBasePosix' = New.decodeWithBasePosix' +{-# INLINE decodeWithBasePosix' #-} + +encodeWithBasePosix' :: String -> IO ShortByteString +encodeWithBasePosix' = New.encodeWithBasePosix' +{-# INLINE encodeWithBasePosix' #-} +# endif + +#endif
+ src/System/OsString/Internal/Compat.hs view
@@ -0,0 +1,736 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE KindSignatures #-}++module System.OsString.Internal.Compat+ ( + -- * OsString construction+ encodeUtf+ , unsafeEncodeUtf+ , encodeWith+ , encodeFS+#if MIN_VERSION_os_string(2,0,5)+ , encodeLE+#endif+ , osstr+ , empty+ , singleton+ , pack+ , fromBytes+#if MIN_VERSION_os_string(2,0,8)+ , fromShortBytes+#endif++ -- * OsString deconstruction+ , decodeUtf+ , decodeWith+ , decodeFS+#if MIN_VERSION_os_string(2,0,5)+ , decodeLE+#endif+ , unpack++ -- * Word construction+ , unsafeFromChar++ -- * Word deconstruction+ , toChar++ -- * Basic interface+ , snoc+ , cons+ , last+ , tail+ , uncons+ , head+ , init+ , unsnoc+ , null+ , length+ , lengthBytes++ -- * Transforming OsString+ , map+ , reverse+ , intercalate++ -- * Reducing OsStrings (folds)+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr'+ , foldr1+ , foldr1'++ -- * Special folds+ , all+ , any+ , concat++ -- * Generating and unfolding OsStrings+ , replicate+ , unfoldr+ , unfoldrN++ -- * Substrings+ -- ** Breaking strings+ , take+ , takeEnd+ , takeWhileEnd+ , takeWhile+ , drop+ , dropEnd+ , dropWhileEnd+ , dropWhile+ , break+ , breakEnd+ , span+ , spanEnd+ , splitAt+ , split+ , splitWith+ , stripSuffix+ , stripPrefix++ -- * Predicates+ , isInfixOf+ , isPrefixOf+ , isSuffixOf+ -- ** Search for arbitrary susbstrings+ , breakSubstring++ -- * Searching OsStrings+ -- ** Searching by equality+ , elem+ , find+ , filter+ , partition++ -- * Indexing OsStrings+ , index+ , indexMaybe+ , (!?)+ , elemIndex+ , elemIndices+ , count+ , findIndex+ , findIndices+ ) where++import System.OsString.Internal.Types.Compat++#if MIN_VERSION_filepath(1,5,0)++import Prelude (Int)+import Data.Coerce (coerce)++-- These should have the same types as in+-- System.OsString.Internal.Types.Compat, so+-- it shouldn't be a problem to use this directly.+import "os-string" System.OsString.Internal hiding (length)++#if defined(mingw32_HOST_OS)+import System.OsString.Windows.Compat qualified as PF+#else+import System.OsString.Posix.Compat qualified as PF+#endif++-- | /O(1)/ The length of an `OsString`.+--+-- This returns the number of code units+-- (@Word8@ on unix and @Word16@ on windows), not+-- bytes.+length :: OsString -> Int+length = coerce PF.length++-- | /O(1)/ The length in bytes of an `OsString`.+--+-- This always returns the number of bytes,+-- regardless of which platform you're on.+lengthBytes :: OsString -> Int+lengthBytes = coerce PF.lengthBytes++-- End of filepath >= 1.5.0 section+#else++import Data.Kind (Type)++import Data.ByteString.Short (ShortByteString(..))++import Data.Coerce+++import "filepath" System.OsString.Internal+ ( encodeUtf+ , encodeWith+ , fromBytes+ , osstr+ , pack+ , decodeUtf+ , decodeWith+ , decodeFS+ , unpack+ , unsafeFromChar+ -- , toChar++ )++-- Needed to allow coercions.+import "os-string" System.OsString.Internal.Types qualified as OST++import "os-string" System.OsString.Internal qualified as OS+import "filepath" System.OsString.Internal qualified as Old++import System.OsString.Internal.Types.Compat++#if defined(mingw32_HOST_OS)+import System.OsString.Windows.Compat qualified as PF+#else+import System.OsString.Posix.Compat qualified as PF+#endif++import Control.Monad.Catch (MonadThrow)++import GHC.Stack (HasCallStack)+import Prelude (Bool, Int, Maybe, String, IO, Char, (<$>))++-- | Unsafe unicode friendly encoding.+--+-- Like 'encodeUtf', except it crashes when the input contains+-- surrogate chars. For sanitized input, this can be useful.+unsafeEncodeUtf :: HasCallStack => String -> OsString+unsafeEncodeUtf = coerce OS.unsafeEncodeUtf++-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which is:+--+-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,+-- but PEP 383 only works properly on UTF-8 encodings, so good luck)+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+--+encodeFS :: String -> IO OsString+encodeFS = coerce OS.encodeFS++#if MIN_VERSION_os_string(2,0,5)+-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing string+-- operations, which is:+--+-- 1. on unix this uses 'getLocaleEncoding'+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+encodeLE :: String -> IO OsString+encodeLE = coerce OS.encodeLE+#endif++-- Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which is:+--+-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,+-- but PEP 383 only works properly on UTF-8 encodings, so good luck)+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+--+-- Note: this is different from `decodeFS` provided by older versions+-- of filepath. That function is equivalent to `decodeLE` in "os-string".+-- decodeFS :: OsString -> IO String+-- decodeFS = coerce OS.encodeFS++#if MIN_VERSION_os_string(2,0,5)+-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing string operations,+-- which is:+--+-- 1. on unix this uses 'getLocaleEncoding'+-- 2. on windows does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+decodeLE :: OsString -> IO String+decodeLE = coerce OS.decodeLE+#endif++empty :: OsString+empty = coerce OS.empty++singleton :: OsChar -> OsString+singleton = coerce OS.singleton++-- | Converts back to a unicode codepoint (total).+--+-- Note that this uses the version from os-string, not filepath+toChar :: OsChar -> Char+toChar = coerce OS.toChar++-- | /O(n)/ Append a byte/word to the end of an `OsString`+snoc :: OsString -> OsChar -> OsString+snoc = coerce OS.snoc++-- | /O(n)/ 'cons' is analogous to (:) for lists.+cons :: OsChar -> OsString -> OsString+cons = coerce OS.cons++-- | /O(1)/ Extract the last element of an `OsString`, which must be finite and non-empty.+-- An exception will be thrown in the case of an empty OsString.+--+-- This is a partial function, consider using 'unsnoc' instead.+last :: HasCallStack => OsString -> OsChar+last = coerce OS.last++-- | /O(n)/ Extract the elements after the head of an `OsString`, which must be non-empty.+-- An exception will be thrown in the case of an empty OsString.+--+-- This is a partial function, consider using 'uncons' instead.+tail :: HasCallStack => OsString -> OsString+tail = coerce OS.tail++-- | /O(n)/ Extract the 'head' and 'tail' of an `OsString`, returning 'Nothing'+-- if it is empty.+uncons :: OsString -> Maybe (OsChar, OsString)+uncons = coerce OS.uncons++-- | /O(1)/ Extract the first element of an `OsString`, which must be non-empty.+-- An exception will be thrown in the case of an empty OsString.+--+-- This is a partial function, consider using 'uncons' instead.+head :: HasCallStack => OsString -> OsChar+head = coerce OS.head++-- | /O(n)/ Return all the elements of an `OsString` except the last one.+-- An exception will be thrown in the case of an empty OsString.+--+-- This is a partial function, consider using 'unsnoc' instead.+init :: HasCallStack => OsString -> OsString+init = coerce OS.init++-- | /O(n)/ Extract the 'init' and 'last' of an `OsString`, returning 'Nothing'+-- if it is empty.+unsnoc :: OsString -> Maybe (OsString, OsChar)+unsnoc = coerce OS.unsnoc++-- | /O(1)/ Test whether an `OsString` is empty.+null :: OsString -> Bool+null = coerce OS.null++-- | /O(1)/ The length of an `OsString`.+--+-- This returns the number of code units+-- (@Word8@ on unix and @Word16@ on windows), not+-- bytes.+length :: OsString -> Int+length = coerce PF.length++-- | /O(1)/ The length in bytes of an `OsString`.+--+-- This always returns the number of bytes,+-- regardless of which platform you're on.+lengthBytes :: OsString -> Int+lengthBytes = coerce PF.lengthBytes++-- | /O(n)/ 'map' @f xs@ is the OsString obtained by applying @f@ to each+-- element of @xs@.+map :: (OsChar -> OsChar) -> OsString -> OsString+map = coerce OS.map++-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.+reverse :: OsString -> OsString+reverse = coerce OS.reverse++-- | /O(n)/ The 'intercalate' function takes an `OsString` and a list of+-- 'OsString's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: OsString -> [OsString] -> OsString+intercalate = coerce OS.intercalate++-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and an `OsString`, reduces the+-- OsString using the binary operator, from left to right.+foldl :: forall a. (a -> OsChar -> a) -> a -> OsString -> a+foldl = coerce (OS.foldl @a)++-- | 'foldl'' is like 'foldl', but strict in the accumulator.+foldl' :: forall a. (a -> OsChar -> a) -> a -> OsString -> a+foldl' = coerce (OS.foldl' @a)++-- | 'foldl1' is a variant of 'foldl' that has no starting value+-- argument, and thus must be applied to non-empty 'OsString's.+-- An exception will be thrown in the case of an empty OsString.+foldl1 :: (OsChar -> OsChar -> OsChar) -> OsString -> OsChar+foldl1 = coerce OS.foldl1++-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.+-- An exception will be thrown in the case of an empty OsString.+foldl1' :: (OsChar -> OsChar -> OsChar) -> OsString -> OsChar+foldl1' = coerce OS.foldl1'+++-- | 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and an `OsString`,+-- reduces the OsString using the binary operator, from right to left.+foldr :: forall a. (OsChar -> a -> a) -> a -> OsString -> a+foldr = coerce (OS.foldr @a)++-- | 'foldr'' is like 'foldr', but strict in the accumulator.+foldr' :: forall a. (OsChar -> a -> a) -> a -> OsString -> a+foldr' = coerce (OS.foldr' @a)++-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty 'OsString's+-- An exception will be thrown in the case of an empty OsString.+foldr1 :: (OsChar -> OsChar -> OsChar) -> OsString -> OsChar+foldr1 = coerce OS.foldr1++-- | 'foldr1'' is a variant of 'foldr1', but is strict in the+-- accumulator.+foldr1' :: (OsChar -> OsChar -> OsChar) -> OsString -> OsChar+foldr1' = coerce OS.foldr1'++-- | /O(n)/ Applied to a predicate and an `OsString`, 'all' determines+-- if all elements of the 'OsString' satisfy the predicate.+all :: (OsChar -> Bool) -> OsString -> Bool+all = coerce OS.all++-- | /O(n)/ Applied to a predicate and an `OsString`, 'any' determines if+-- any element of the 'OsString' satisfies the predicate.+any :: (OsChar -> Bool) -> OsString -> Bool+any = coerce OS.any++-- /O(n)/ Concatenate a list of OsStrings.+--+concat :: [OsString] -> OsString+concat = coerce OS.concat++-- | /O(n)/ 'replicate' @n x@ is an `OsString` of length @n@ with @x@+-- the value of every element. The following holds:+--+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c+--+replicate :: Int -> OsChar -> OsString+replicate = coerce OS.replicate++-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a+-- OsString from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the OsString or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,+-- and @b@ is the seed value for further production.+--+-- This function is not efficient/safe. It will build a list of @[Word8]@+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,+-- then finally create an `OsString`.+--+-- If you know the maximum length, consider using 'unfoldrN'.+--+-- Examples:+--+-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0+-- > == pack [0, 1, 2, 3, 4, 5]+--+unfoldr :: forall a. (a -> Maybe (OsChar, a)) -> a -> OsString+unfoldr = coerce (OS.unfoldr @a)++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds an `OsString` from a seed+-- value. However, the length of the result is limited by the first+-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'+-- when the maximum length of the result is known.+--+-- The following equation relates 'unfoldrN' and 'unfoldr':+--+-- > fst (unfoldrN n f s) == take n (unfoldr f s)+--+unfoldrN :: forall a. Int -> (a -> Maybe (OsChar, a)) -> a -> (OsString, Maybe a)+unfoldrN = coerce (OS.unfoldrN @a)++-- | /O(n)/ 'take' @n@, applied to an `OsString` @xs@, returns the prefix+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+take :: Int -> OsString -> OsString+take = coerce OS.take++-- | /O(n)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+-- >>> takeEnd 0 "abcdefg"+-- ""+-- >>> takeEnd 4 "abc"+-- "abc"+--+takeEnd :: Int -> OsString -> OsString+takeEnd = coerce OS.takeEnd++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate.+--+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.+--+takeWhileEnd :: (OsChar -> Bool) -> OsString -> OsString+takeWhileEnd = coerce OS.takeWhileEnd++-- | Similar to 'Prelude.takeWhile',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate.+takeWhile :: (OsChar -> Bool) -> OsString -> OsString+takeWhile = coerce OS.takeWhile++-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or 'empty' if @n > 'length' xs@.+drop :: Int -> OsString -> OsString+drop = coerce OS.drop++-- | /O(n)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "abcdefg"+-- "abcd"+-- >>> dropEnd 0 "abcdefg"+-- "abcdefg"+-- >>> dropEnd 4 "abc"+-- ""+dropEnd :: Int -> OsString -> OsString+dropEnd = coerce OS.dropEnd++-- | Similar to 'Prelude.dropWhile',+-- drops the longest (possibly empty) prefix of elements+-- satisfying the predicate and returns the remainder.+dropWhile :: (OsChar -> Bool) -> OsString -> OsString+dropWhile = coerce OS.dropWhile++-- | Similar to 'Prelude.dropWhileEnd',+-- drops the longest (possibly empty) suffix of elements+-- satisfying the predicate and returns the remainder.+--+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.+--+dropWhileEnd :: (OsChar -> Bool) -> OsString -> OsString+dropWhileEnd = coerce OS.dropWhileEnd++-- | Returns the longest (possibly empty) suffix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+breakEnd :: (OsChar -> Bool) -> OsString -> (OsString, OsString)+breakEnd = coerce OS.breakEnd++-- | Similar to 'Prelude.break',+-- returns the longest (possibly empty) prefix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.+break :: (OsChar -> Bool) -> OsString -> (OsString, OsString)+break = coerce OS.break++-- | Similar to 'Prelude.span',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.+--+span :: (OsChar -> Bool) -> OsString -> (OsString, OsString)+span = coerce OS.span++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+--+-- We have+--+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")+--+-- and+--+-- > spanEnd (not . isSpace) sbs+-- > ==+-- > let (x, y) = span (not . isSpace) (reverse sbs) in (reverse y, reverse x)+--+spanEnd :: (OsChar -> Bool) -> OsString -> (OsString, OsString)+spanEnd = coerce OS.spanEnd++-- | /O(n)/ 'splitAt' @n sbs@ is equivalent to @('take' n sbs, 'drop' n sbs)@.+splitAt :: Int -> OsString -> (OsString, OsString)+splitAt = coerce OS.splitAt++-- | /O(n)/ Break an `OsString` into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120+-- > split undefined "" == [] -- and not [""]+--+-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+--+split :: OsChar -> OsString -> [OsString]+split = coerce OS.split++-- | /O(n)/ Splits an `OsString` into components delimited by+-- separators, where the predicate returns True for a separator element.+-- The resulting components do not contain the separators. Two adjacent+-- separators result in an empty component in the output. eg.+--+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith undefined "" == [] -- and not [""]+--+splitWith :: (OsChar -> Bool) -> OsString -> [OsString]+splitWith = coerce OS.splitWith++-- | /O(n)/ The 'stripSuffix' function takes two OsStrings and returns 'Just'+-- the remainder of the second iff the first is its suffix, and otherwise+-- 'Nothing'.+stripSuffix :: OsString -> OsString -> Maybe OsString+stripSuffix = coerce OS.stripSuffix++-- | /O(n)/ The 'stripPrefix' function takes two OsStrings and returns 'Just'+-- the remainder of the second iff the first is its prefix, and otherwise+-- 'Nothing'.+stripPrefix :: OsString -> OsString -> Maybe OsString+stripPrefix = coerce OS.stripPrefix+++-- | Check whether one string is a substring of another.+isInfixOf :: OsString -> OsString -> Bool+isInfixOf = coerce OS.isInfixOf++-- |/O(n)/ The 'isPrefixOf' function takes two OsStrings and returns 'True'+isPrefixOf :: OsString -> OsString -> Bool+isPrefixOf = coerce OS.isPrefixOf++-- | /O(n)/ The 'isSuffixOf' function takes two OsStrings and returns 'True'+-- iff the first is a suffix of the second.+--+-- The following holds:+--+-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y+--+isSuffixOf :: OsString -> OsString -> Bool+isSuffixOf = coerce OS.isSuffixOf++-- | Break a string on a substring, returning a pair of the part of the+-- string prior to the match, and the rest of the string.+--+-- The following relationships hold:+--+-- > break (== c) l == breakSubstring (singleton c) l+--+-- For example, to tokenise a string, dropping delimiters:+--+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)+-- > where (h,t) = breakSubstring x y+--+-- To skip to the first occurrence of a string:+--+-- > snd (breakSubstring x y)+--+-- To take the parts of a string before a delimiter:+--+-- > fst (breakSubstring x y)+--+-- Note that calling `breakSubstring x` does some preprocessing work, so+-- you should avoid unnecessarily duplicating breakSubstring calls with the same+-- pattern.+breakSubstring :: OsString -> OsString -> (OsString, OsString)+breakSubstring = coerce OS.breakSubstring++-- | /O(n)/ 'elem' is the 'OsString' membership predicate.+elem :: OsChar -> OsString -> Bool+elem = coerce OS.elem++-- | /O(n)/ The 'find' function takes a predicate and an `OsString`,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+--+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing+--+find :: (OsChar -> Bool) -> OsString -> Maybe OsChar+find = coerce OS.find++-- | /O(n)/ 'filter', applied to a predicate and an `OsString`,+-- returns an `OsString` containing those characters that satisfy the+-- predicate.+filter :: (OsChar -> Bool) -> OsString -> OsString+filter = coerce OS.filter++-- | /O(n)/ The 'partition' function takes a predicate an `OsString` and returns+-- the pair of OsStrings with elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p bs == (filter p sbs, filter (not . p) sbs)+--+partition :: (OsChar -> Bool) -> OsString -> (OsString, OsString)+partition = coerce OS.partition++-- | /O(1)/ 'OsString' index (subscript) operator, starting from 0.+index :: HasCallStack => OsString -> Int -> OsChar+index = coerce OS.index++-- | /O(1)/ 'OsString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+indexMaybe :: OsString -> Int -> Maybe OsChar+indexMaybe = coerce OS.indexMaybe++-- | /O(1)/ 'OsString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+(!?) :: OsString -> Int -> Maybe OsChar+(!?) = indexMaybe++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'OsString' which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: OsChar -> OsString -> Maybe Int+elemIndex = coerce OS.elemIndex++-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning+-- the indices of all elements equal to the query element, in ascending order.+elemIndices :: OsChar -> OsString -> [Int]+elemIndices = coerce OS.elemIndices++-- | count returns the number of times its argument appears in the OsString+count :: OsChar -> OsString -> Int+count = coerce OS.count++-- | /O(n)/ The 'findIndex' function takes a predicate and an `OsString` and+-- returns the index of the first element in the OsString+-- satisfying the predicate.+findIndex :: (OsChar -> Bool) -> OsString -> Maybe Int+findIndex = coerce OS.findIndex++-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending order.+findIndices :: (OsChar -> Bool) -> OsString -> [Int]+findIndices = coerce OS.findIndices++#endif++#if MIN_VERSION_os_string(2,0,8) && !(MIN_VERSION_filepath(1,5,0))++-- | Constructs an @OsString@ from a ShortByteString.+--+-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked.+--+-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely).+fromShortBytes :: forall (m :: Type -> Type). MonadThrow m => ShortByteString -> m OsString+fromShortBytes sbs = coerce <$> (OS.fromShortBytes @m sbs)++#endif+
+ src/System/OsString/Internal/Exception/Compat.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE CPP #-} + +module System.OsString.Internal.Exception.Compat + ( trySafe + , isAsyncException + ) where + +#if MIN_VERSION_os_string(2,0,7) +import "os-string" System.OsString.Internal.Exception + ( isAsyncException, trySafe ) +#else + +import Control.Exception ( catch, fromException, toException, throwIO, Exception, SomeAsyncException(..) ) + +-- Again, taken from os-string. + +-- | Like 'try', but rethrows async exceptions. +trySafe :: Exception e => IO a -> IO (Either e a) +trySafe ioA = catch action eHandler + where + action = do + v <- ioA + return (Right v) + eHandler e + | isAsyncException e = throwIO e + | otherwise = return (Left e) + +isAsyncException :: Exception e => e -> Bool +isAsyncException e = + case fromException (toException e) of + Just (SomeAsyncException _) -> True + Nothing -> False + +#endif
+ src/System/OsString/Internal/Types/Compat.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE CPP #-} + +module System.OsString.Internal.Types.Compat + ( WindowsString(..) + , pattern WS + , unWS + , PosixString(..) + , unPS + , pattern PS + , PlatformString + , WindowsChar(..) + , unWW + , pattern WW + , PosixChar(..) + , unPW + , pattern PW + , PlatformChar + , OsString(..) + , OsChar(..) + , coercionToPlatformTypes + ) where + +#if MIN_VERSION_filepath(1,5,0) + +import "os-string" System.OsString.Internal.Types + +# if MIN_VERSION_os_string(2,0,2) +# else +# define COERCE_MANUAL +# endif + +#else + +import "filepath" System.OsString.Internal.Types + +#define COERCE_MANUAL + +#endif + +-- For versions that don't have coercionToPlatformTypes +#ifdef COERCE_MANUAL + +import Data.Type.Coercion (Coercion(..)) + +-- | This is a type-level evidence that 'OsChar' is a newtype wrapper +-- over 'WindowsChar' or 'PosixChar' and 'OsString' is a newtype wrapper +-- over 'WindowsString' or 'PosixString'. If you pattern match on +-- 'coercionToPlatformTypes', GHC will know that relevant types +-- are coercible to each other. This helps to avoid CPP in certain scenarios. +-- +-- Note: normally, this requires os-string >= 2.0.2, but since it's required +-- in the test suite, I've defined it here for os-string-2.0.1 /and/ for +-- older versions of filepath. +coercionToPlatformTypes + :: Either + (Coercion OsChar WindowsChar, Coercion OsString WindowsString) + (Coercion OsChar PosixChar, Coercion OsString PosixString) +# if defined(mingw32_HOST_OS) +coercionToPlatformTypes = Left (Coercion, Coercion) +# else +coercionToPlatformTypes = Right (Coercion, Coercion) +# endif + +#endif
+ src/System/OsString/Posix/Compat.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-} + +-- Note: to find the actual source code for +-- this module, change the last part of the +-- URL to "System.OsString.Common.html" + +#undef WINDOWS +#define MODULE_NAME Posix +#define PLATFORM_STRING PosixString +#define PLATFORM_STR_PLURAL PosixStrings +#define PLATFORM_WORD PosixChar +#define IS_WINDOWS False +#include "../include/Common.hs"
+ src/System/OsString/Windows/Compat.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-} + +-- Note: to find the actual source code for +-- this module, change the last part of the +-- URL to "System.OsString.Common.html" + +#undef POSIX +#define MODULE_NAME Windows +#define PLATFORM_STRING WindowsString +#define PLATFORM_STR_PLURAL WindowsStrings +#define PLATFORM_WORD WindowsChar +#define IS_WINDOWS True +#define WINDOWS +#include "../include/Common.hs" +#undef MODULE_NAME +#undef FILEPATH_NAME +#undef OSSTRING_NAME +#undef IS_WINDOWS +#undef WINDOWS
+ src/System/OsString/include/Common.hs view
@@ -0,0 +1,1171 @@+{- HLINT ignore "Unused LANGUAGE pragma" -}++{-# LANGUAGE CPP #-}++-- To allow this file's source code+-- to be included when using Haddock.+#ifndef MODULE_NAME+{-# OPTIONS_HADDOCK hide #-}++#define MODULE_NAME Posix+#define IS_WINDOWS False+#define PLATFORM_STRING PosixString+#define PLATFORM_STR_PLURAL PosixStrings+#define PLATFORM_WORD PosixChar+#define IS_WINDOWS False+#define IN_HADDOCK+#endif++{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- {-# LANGUAGE TemplateHaskellQuotes #-}+-- {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+++++-- This is essentially copied from os-string.+-- It's located in a folder that starts with+-- a lower-case character so that it doesn't+-- get compiled by default. Instead, it is+-- just to be CPP-included by other modules.++-- This template expects CPP definitions for:+-- MODULE_NAME = Posix | Windows+-- IS_WINDOWS = False | True+--+#if defined(WINDOWS)+#define WINDOWS_DOC+#else+#define POSIX_DOC+#endif++#ifdef IN_HADDOCK+module System.OsString.Common+#else+module System.OsString.MODULE_NAME.Compat+#endif+ (+ -- * Types+#ifdef WINDOWS+ WindowsString+ , WindowsChar+#else+ PosixString+ , PosixChar+#endif++ -- * String construction+ , encodeUtf+ , unsafeEncodeUtf+ , encodeWith+ , encodeFS+#if MIN_VERSION_os_string(2,0,5)+ , encodeLE+#endif+#ifdef WINDOWS+# if MIN_VERSION_os_string(2,0,6)+ , fromString+# endif+#endif+ , fromBytes+#if MIN_VERSION_os_string(2,0,8)+ , fromShortBytes+#endif+#ifndef WINDOWS+# if MIN_VERSION_os_string(2,0,6)+ , fromBytestring+# endif+# if MIN_VERSION_os_string(2,0,8)+ , fromShortBytestring+# endif+#endif+ , pstr+ , singleton+ , empty+ , pack++ -- * String deconstruction+ , decodeUtf+ , decodeWith+ , decodeFS+#if MIN_VERSION_os_string(2,0,5)+ , decodeLE+#endif+ , unpack++ -- * Word construction+ , unsafeFromChar++ -- * Word deconstruction+ , toChar++ -- * Basic interface+ , snoc+ , cons+ , last+ , tail+ , uncons+ , head+ , init+ , unsnoc+ , null+ , length+ , lengthBytes++ -- * Transforming PLATFORM_STR_PLURAL+ , map+ , reverse+ , intercalate++ -- * Reducing PLATFORM_STR_PLURAL (folds)+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr'+ , foldr1+ , foldr1'++ -- ** Special folds+ , all+ , any+ , concat++ -- ** Generating and unfolding PLATFORM_STR_PLURAL+ , replicate+ , unfoldr+ , unfoldrN++ -- * Substrings+ -- ** Breaking strings+ , take+ , takeEnd+ , takeWhileEnd+ , takeWhile+ , drop+ , dropEnd+ , dropWhileEnd+ , dropWhile+ , break+ , breakEnd+ , span+ , spanEnd+ , splitAt+ , split+ , splitWith+ , stripSuffix+ , stripPrefix++ -- * Predicates+ , isInfixOf+ , isPrefixOf+ , isSuffixOf+ -- ** Search for arbitrary susbstrings+ , breakSubstring++ -- * Searching PLATFORM_STR_PLURAL+ -- ** Searching by equality+ , elem+ , find+ , filter+ , partition++ -- * Indexing PLATFORM_STR_PLURAL+ , index+ , indexMaybe+ , (!?)+ , elemIndex+ , elemIndices+ , count+ , findIndex+ , findIndices+ )+where++#if MIN_VERSION_filepath(1,5,0)++import Prelude (Int)++import "os-string" System.OsString.Internal.Types qualified as NewT (PLATFORM_STRING(..), PLATFORM_WORD(..))+import System.OsString.Internal.Types.Compat (PLATFORM_STRING(..), PLATFORM_WORD(..))++import "os-string" System.OsString.MODULE_NAME hiding (length)++import Data.Coerce++# ifdef WINDOWS+import "os-string" System.OsString.Data.ByteString.Short.Word16 qualified as B16+# else+import "os-string" System.OsString.Data.ByteString.Short qualified as B8+# endif++-- | /O(1)/ The length of a `PLATFORM_STRING`.+--+-- This returns the number of code units+-- (@Word8@ on unix and @Word16@ on windows), not+-- bytes.+--+-- >>> length "abc"+-- 3+--+-- Note: older versions of os-string return the+-- length in bytes, rather than the length in+-- code units. This will return the length in+-- code units, regardless of the version of +-- os-string. For checking the length in Bytes,+-- use `lengthBytes`.+length :: PLATFORM_STRING -> Int+-- length = coerce New.length+#ifdef WINDOWS+length = coerce B16.numWord16+#else+length = coerce B8.length+#endif++-- | /O(1)/ The length in bytes of a `PLATFORM_STRING`.+--+-- If you want the number of code units, just+-- use `length` instead.+lengthBytes :: PLATFORM_STRING -> Int+#ifdef WINDOWS+lengthBytes = coerce B16.length+#else+lengthBytes = coerce B8.length+#endif++-- End of (filepath >= 1.5.0) section+#else++import "os-string" System.OsString.MODULE_NAME qualified as New++# ifdef WINDOWS+import "os-string" System.OsString.Data.ByteString.Short.Word16 qualified as B16+# else+import "os-string" System.OsString.Data.ByteString.Short qualified as B8+# endif++import "filepath" System.OsString.MODULE_NAME (pstr, encodeWith, decodeWith)++import "os-string" System.OsString.Internal.Types qualified as NewT (PLATFORM_STRING(..), PLATFORM_WORD(..))+import System.OsString.Internal.Types.Compat (PLATFORM_STRING(..), PLATFORM_WORD(..))++import System.OsString.Internal.Exception.Compat+import System.OsString.Internal.Types.Compat (+#ifdef WINDOWS+ WindowsString(..), WindowsChar(..)+#else+ PosixString(..), PosixChar(..)+#endif+ )++import Data.Coerce+import Data.Char+import Control.Monad.Catch+ ( MonadThrow, throwM )+import Data.ByteString.Internal+ ( ByteString )+import Data.ByteString.Short.Internal+ ( ShortByteString )+import Control.Exception+ ( SomeException, try, displayException )+-- import Control.DeepSeq ( force )+-- import Data.Bifunctor ( first )+-- import GHC.IO+-- ( evaluate, unsafePerformIO )+import qualified GHC.Foreign as GHC+-- import Language.Haskell.TH.Quote+-- ( QuasiQuoter (..) )+-- import Language.Haskell.TH.Syntax+-- ( Lift (..), lift )+++import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )+#ifdef WINDOWS+import System.OsString.Encoding.Compat+import System.IO+ ( TextEncoding, utf16le )+import GHC.IO.Encoding.UTF16 ( mkUTF16le )+import System.OsString.Data.ByteString.Short.Word16 qualified as BSP+#else+import System.OsString.Encoding.Compat+import System.IO+ ( TextEncoding, utf8 )+import GHC.IO.Encoding.UTF8 ( mkUTF8 )+import qualified System.OsString.Data.ByteString.Short as BSP+#endif+import GHC.Stack (HasCallStack)+import Prelude (Bool(..), Int, Maybe(..), IO, String, Either(..), fmap, ($), (.), mconcat, fromEnum, fromInteger, mempty, fromIntegral, fail, (<$>), show, either, pure, const, flip, error, id)+-- import Data.Bifunctor ( bimap )+-- import qualified System.OsString.Data.ByteString.Short.Word16 as BS16+-- import qualified System.OsString.Data.ByteString.Short as BS8++++#ifdef WINDOWS_DOC+-- | Partial unicode friendly encoding.+--+-- This encodes as UTF16-LE (strictly), which is a pretty good guess.+--+-- Throws an 'EncodingException' if encoding fails. If the input does not+-- contain surrogate chars, you can use @unsafeEncodeUtf@.+#else+-- | Partial unicode friendly encoding.+--+-- This encodes as UTF8 (strictly), which is a good guess.+--+-- Throws an 'EncodingException' if encoding fails. If the input does not+-- contain surrogate chars, you can use 'unsafeEncodeUtf'.+#endif+encodeUtf :: MonadThrow m => String -> m PLATFORM_STRING+encodeUtf str = coerce <$> New.encodeUtf str+-- #ifdef WINDOWS+-- encodeUtf = either throwM pure . encodeWith utf16le+-- #else+-- encodeUtf = either throwM pure . encodeWith utf8+-- #endif++-- | Unsafe unicode friendly encoding.+--+-- Like 'encodeUtf', except it crashes when the input contains+-- surrogate chars. For sanitized input, this can be useful.+unsafeEncodeUtf :: HasCallStack => String -> PLATFORM_STRING+#ifdef WINDOWS+unsafeEncodeUtf = coerce New.unsafeEncodeUtf -- either (error . displayException) id . encodeWith utf16le+#else+unsafeEncodeUtf = coerce New.unsafeEncodeUtf -- either (error . displayException) id . encodeWith utf8+#endif++{-+#ifdef WINDOWS+-- | Encode a 'String' with the specified encoding.+--+-- Note: We expect a "wide char" encoding (e.g. UCS-2 or UTF-16). Anything+-- that works with @Word16@ boundaries. Picking an incompatible encoding may crash+-- filepath operations.+encodeWith :: TextEncoding -- ^ text encoding (wide char)+ -> String+ -> Either EncodingException PLATFORM_STRING+encodeWith = coerce New.encodeWith+#else+-- | Encode a 'String' with the specified encoding.+encodeWith :: TextEncoding+ -> String+ -> Either EncodingException PLATFORM_STRING+encodeWith = coerce New.encodeWith+#endif+-}++#ifdef WINDOWS_DOC+-- | This mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range.+--+-- The reason this is in IO is because it unifies with the Posix counterpart,+-- which does require IO. This is safe to 'unsafePerformIO'/'unsafeDupablePerformIO'.+#else+-- | This mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which uses shady PEP 383 style encoding (based on the current locale,+-- but PEP 383 only works properly on UTF-8 encodings, so good luck).+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+#endif+encodeFS :: String -> IO PLATFORM_STRING+#ifdef WINDOWS+{-# DEPRECATED encodeFS "Use System.OsPath.Windows.encodeFS from filepath" #-}+encodeFS = coerce New.encodeFS+#else+{-# DEPRECATED encodeFS "Use System.OsPath.Posix.encodeFS from filepath" #-}+encodeFS = coerce New.encodeFS+#endif++#if MIN_VERSION_os_string(2,0,5)+# ifdef WINDOWS_DOC+-- | This mimics the behavior of the base library when doing string+-- operations, which does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range.+--+-- The reason this is in IO is because it unifies with the Posix counterpart,+-- which does require IO. This is safe to 'unsafePerformIO'/'unsafeDupablePerformIO'.+# else+-- | This mimics the behavior of the base library when doing string+-- operations, which uses 'getLocaleEncoding'.+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+# endif+encodeLE :: String -> IO PLATFORM_STRING+# ifdef WINDOWS+encodeLE = coerce New.encodeLE+# else+encodeLE = coerce New.encodeLE+# endif+#endif++#ifdef WINDOWS+# if MIN_VERSION_os_string(2,0,6)+-- | Like 'encodeLE but not in IO.+--+-- 'encodeLE' was designed to have a symmetric type signature+-- on unix and windows, but morally the function has no IO effects on windows,+-- so we provide this variant without breaking existing API.+--+-- On windows, 'encodeLE' is equivalent to 'encodeFS'.+--+-- This function does not exist on unix.+--+-- @since 2.0.6+fromString :: String -> WindowsString+fromString = coerce New.fromString+# endif+#endif++#ifdef WINDOWS_DOC+-- | Partial unicode friendly decoding.+--+-- This decodes as UTF16-LE (strictly), which is a pretty good.+--+-- Throws a 'EncodingException' if decoding fails.+#else+-- | Partial unicode friendly decoding.+--+-- This decodes as UTF8 (strictly), which is a good guess. Note that+-- filenames on unix are encoding agnostic char arrays.+--+-- Throws a 'EncodingException' if decoding fails.+#endif+decodeUtf :: MonadThrow m => PLATFORM_STRING -> m String+#ifdef WINDOWS+decodeUtf str = New.decodeUtf (coerce str)+#else+decodeUtf str = New.decodeUtf (coerce str)+#endif++{-+#ifdef WINDOWS+-- | Decode a 'WindowsString' with the specified encoding.+--+-- The String is forced into memory to catch all exceptions.+decodeWith :: TextEncoding+ -> PLATFORM_STRING+ -> Either EncodingException String+decodeWith = coerce New.decodeWith+-- decodeWith winEnc (WindowsString ba) = unsafePerformIO $ do+-- r <- trySafe @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp+-- evaluate $ force $ first (flip EncodingError Nothing . displayException) r+#else+-- | Decode a 'PosixString' with the specified encoding.+--+-- The String is forced into memory to catch all exceptions.+decodeWith :: TextEncoding+ -> PLATFORM_STRING+ -> Either EncodingException String+decodeWith = coerce New.decodeWith+-- decodeWith unixEnc (PosixString ba) = unsafePerformIO $ do+-- r <- trySafe @SomeException $ BSP.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp+-- evaluate $ force $ first (flip EncodingError Nothing . displayException) r+#endif+-}++#if MIN_VERSION_os_string(2,0,5)+#ifdef WINDOWS_DOC+-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem+-- operations, which does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range.+--+-- The reason this is in IO is because it unifies with the Posix counterpart,+-- which does require IO. 'unsafePerformIO'/'unsafeDupablePerformIO' are safe, however.+#else+-- | This mimics the behavior of the base library when doing filesystem+-- operations, which uses 'getLocaleEncoding'.+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+#endif+decodeLE :: PLATFORM_STRING -> IO String+decodeLE = coerce New.decodeLE+#endif++#ifdef WINDOWS_DOC+-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which does permissive UTF-16 encoding, where coding errors generate+-- Chars in the surrogate range.+--+-- The reason this is in IO is because it unifies with the Posix counterpart,+-- which does require IO. 'unsafePerformIO'/'unsafeDupablePerformIO' are safe, however.+#else+-- | This mimics the behavior of the base library when doing filesystem+-- operations (usually filepaths), which uses shady PEP 383 style encoding (based on the current locale,+-- but PEP 383 only works properly on UTF-8 encodings, so good luck).+--+-- Looking up the locale requires IO. If you're not worried about calls+-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure+-- to deeply evaluate the result to catch exceptions).+#endif+decodeFS :: PLATFORM_STRING -> IO String+#ifdef WINDOWS+{-# DEPRECATED decodeFS "Use System.OsPath.Windows.decodeFS from filepath" #-}+decodeFS = coerce New.decodeFS+-- decodeFS (WindowsString ba) = decodeWithBaseWindows ba+#else+{-# DEPRECATED decodeFS "Use System.OsPath.Posix.decodeFS from filepath" #-}+decodeFS = coerce New.decodeFS+-- decodeFS (PosixString ba) = decodeWithBasePosix ba+#endif+++#ifdef WINDOWS_DOC+-- | Constructs a platform string from a ByteString.+--+-- This ensures valid UCS-2LE.+-- Note that this doesn't expand Word8 to Word16 on windows, so you may get invalid UTF-16.+--+-- Throws 'EncodingException' on invalid UCS-2LE (although unlikely).+#else+-- | Constructs a platform string from a ByteString.+--+-- This is a no-op.+#endif+fromBytes :: MonadThrow m+ => ByteString+ -> m PLATFORM_STRING+fromBytes bs = coerce <$> New.fromBytes bs+-- fromBytes = fromShortBytes . BS16.toShort++#if MIN_VERSION_os_string(2,0,8)+#ifdef WINDOWS_DOC+-- | Constructs a platform string from a ShortByteString.+--+-- This ensures valid UCS-2LE.+-- Note that this doesn't expand Word8 to Word16 on windows, so you may get invalid UTF-16.+--+-- Throws 'EncodingException' on invalid UCS-2LE (although unlikely).+--+-- @since 2.0.8+#else+-- | Constructs a platform string from a ShortByteString.+--+-- This is a no-op.+--+-- @since 2.0.8+#endif+fromShortBytes :: MonadThrow m+ => ShortByteString+ -> m PLATFORM_STRING+fromShortBytes sbs = coerce <$> New.fromShortBytes sbs+#endif++-- #ifdef WINDOWS+-- fromShortBytes bs =+-- let ws = WindowsString bs+-- in either throwM (const . pure $ ws) $ decodeWith ucs2le ws+-- #else+-- fromShortBytes = pure . PosixString+-- #endif++#ifndef WINDOWS+# if MIN_VERSION_os_string(2,0,6)+-- | Like 'fromBytes', but not in IO.+--+-- 'fromBytes' was designed to have a symmetric type signature+-- on unix and windows, but morally the function has no IO effects on unix,+-- so we provide this variant without breaking existing API.+--+-- This function does not exist on windows.+--+-- @since 2.0.6+fromBytestring :: ByteString -> PosixString+fromBytestring = coerce New.fromBytestring+-- fromBytestring = PosixString . BSP.toShort+# endif++# if MIN_VERSION_os_string(2,0,8)+-- | Like 'fromShortBytes', but not in IO, similarly to 'fromBytestring'+--+-- @since 2.0.8+fromShortBytestring :: ShortByteString -> PosixString+fromShortBytestring = coerce New.fromShortBytestring+-- fromShortBytestring = PosixString+# endif+#endif+++-- pstr is included in the old version+{-+#ifdef WINDOWS_DOC+-- | QuasiQuote a 'WindowsString'. This accepts Unicode characters+-- and encodes as UTF-16LE on windows.+#else+-- | QuasiQuote a 'PosixString'. This accepts Unicode characters+-- and encodes as UTF-8 on unix.+#endif+pstr :: QuasiQuoter+pstr =+ QuasiQuoter+#ifdef WINDOWS+ { quoteExp = \s -> do+ ps <- either (fail . show) pure $ encodeWith (mkUTF16le ErrorOnCodingFailure) s+ lift ps+ , quotePat = \s -> do+ osp' <- either (fail . show) pure . encodeWith (mkUTF16le ErrorOnCodingFailure) $ s+ [p|((==) osp' -> True)|]+ , quoteType = \_ ->+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"+ , quoteDec = \_ ->+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"+ }+#else+ { quoteExp = \s -> do+ ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s+ lift ps+ , quotePat = \s -> do+ osp' <- either (fail . show) pure . encodeWith (mkUTF8 ErrorOnCodingFailure) $ s+ [p|((==) osp' -> True)|]+ , quoteType = \_ ->+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)"+ , quoteDec = \_ ->+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"+ }+#endif+-}++-- | Unpack a platform string to a list of platform words.+unpack :: PLATFORM_STRING -> [PLATFORM_WORD]+unpack = coerce New.unpack+++-- | Pack a list of platform words to a platform string.+--+-- Note that using this in conjunction with 'unsafeFromChar' to+-- convert from @[Char]@ to platform string is probably not what+-- you want, because it will truncate unicode code points.+pack :: [PLATFORM_WORD] -> PLATFORM_STRING+pack = coerce New.pack++singleton :: PLATFORM_WORD -> PLATFORM_STRING+singleton = coerce New.singleton++empty :: PLATFORM_STRING+empty = mempty+++#ifdef WINDOWS+-- | Truncates to 2 octets.+unsafeFromChar :: Char -> PLATFORM_WORD+unsafeFromChar = coerce New.unsafeFromChar+#else+-- | Truncates to 1 octet.+unsafeFromChar :: Char -> PLATFORM_WORD+unsafeFromChar = coerce New.unsafeFromChar+#endif++-- | Converts back to a unicode codepoint (total).+toChar :: PLATFORM_WORD -> Char+#ifdef WINDOWS+toChar = coerce New.toChar+#else+toChar = coerce New.toChar+#endif++-- | /O(n)/ Append a byte to the end of a `PLATFORM_STRING`+--+snoc :: PLATFORM_STRING -> PLATFORM_WORD -> PLATFORM_STRING+snoc = coerce New.snoc++-- | /O(n)/ 'cons' is analogous to (:) for lists.+--+cons :: PLATFORM_WORD -> PLATFORM_STRING -> PLATFORM_STRING+cons = coerce New.cons+++-- | /O(1)/ Extract the last element of a `PLATFORM_STRING`, which must be finite and non-empty.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+-- This is a partial function, consider using 'unsnoc' instead.+--+last :: HasCallStack => PLATFORM_STRING -> PLATFORM_WORD+last = coerce New.last++-- | /O(n)/ Extract the elements after the head of a `PLATFORM_STRING`, which must be non-empty.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+-- This is a partial function, consider using 'uncons' instead.+--+tail :: HasCallStack => PLATFORM_STRING -> PLATFORM_STRING+tail = coerce New.tail++-- | /O(n)/ Extract the 'head' and 'tail' of a `PLATFORM_STRING`, returning 'Nothing'+-- if it is empty.+--+uncons :: PLATFORM_STRING -> Maybe (PLATFORM_WORD, PLATFORM_STRING)+uncons = coerce New.uncons++-- | /O(1)/ Extract the first element of a `PLATFORM_STRING`, which must be non-empty.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+-- This is a partial function, consider using 'uncons' instead.+--+head :: HasCallStack => PLATFORM_STRING -> PLATFORM_WORD+head = coerce New.head++-- | /O(n)/ Return all the elements of a `PLATFORM_STRING` except the last one.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+-- This is a partial function, consider using 'unsnoc' instead.+--+init :: HasCallStack => PLATFORM_STRING -> PLATFORM_STRING+init = coerce New.init++-- | /O(n)/ Extract the 'init' and 'last' of a `PLATFORM_STRING`, returning 'Nothing'+-- if it is empty.+--+unsnoc :: PLATFORM_STRING -> Maybe (PLATFORM_STRING, PLATFORM_WORD)+unsnoc = coerce New.unsnoc++-- | /O(1)/. The empty `PLATFORM_STRING`.+--+null :: PLATFORM_STRING -> Bool+null = coerce New.null++-- | /O(1)/ The length of a `PLATFORM_STRING`.+--+-- This returns the number of code units+-- (@Word8@ on unix and @Word16@ on windows), not+-- bytes.+--+-- >>> length "abc"+-- 3+--+-- Note: older versions of os-string return the+-- length in bytes, rather than the length in+-- code units. This will return the length in+-- code units, regardless of the version of +-- os-string. For checking the length in Bytes,+-- use `lengthBytes`.+length :: PLATFORM_STRING -> Int+-- length = coerce New.length+#ifdef WINDOWS+length = coerce B16.numWord16+#else+length = coerce B8.length+#endif++-- | /O(1)/ The length in bytes of a `PLATFORM_STRING`.+--+-- If you want the number of code units, just+-- use `length` instead.+lengthBytes :: PLATFORM_STRING -> Int+#ifdef WINDOWS+lengthBytes = coerce B16.length+#else+lengthBytes = coerce B8.length+#endif+++-- | /O(n)/ 'map' @f xs@ is the `PLATFORM_STRING` obtained by applying @f@ to each+-- element of @xs@.+--+map :: (PLATFORM_WORD -> PLATFORM_WORD) -> PLATFORM_STRING -> PLATFORM_STRING+map = coerce New.map++-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.+--+reverse :: PLATFORM_STRING -> PLATFORM_STRING+reverse = coerce New.reverse++-- | /O(n)/ The 'intercalate' function takes a `PLATFORM_STRING` and a list of+-- `PLATFORM_STRING`s and concatenates the list after interspersing the first+-- argument between each element of the list.+--+intercalate :: PLATFORM_STRING -> [PLATFORM_STRING] -> PLATFORM_STRING+intercalate = coerce New.intercalate++-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a `PLATFORM_STRING`, reduces the+-- `PLATFORM_STRING` using the binary operator, from left to right.+--+foldl :: forall a. (a -> PLATFORM_WORD -> a) -> a -> PLATFORM_STRING -> a+foldl = coerce (New.foldl @a)++-- | 'foldl'' is like 'foldl', but strict in the accumulator.+--+foldl'+ :: forall a. (a -> PLATFORM_WORD -> a) -> a -> PLATFORM_STRING -> a+foldl' = coerce (New.foldl' @a)++-- | 'foldl1' is a variant of 'foldl' that has no starting value+-- argument, and thus must be applied to non-empty `PLATFORM_STRING`s.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+foldl1 :: (PLATFORM_WORD -> PLATFORM_WORD -> PLATFORM_WORD) -> PLATFORM_STRING -> PLATFORM_WORD+foldl1 = coerce New.foldl1++-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+foldl1'+ :: (PLATFORM_WORD -> PLATFORM_WORD -> PLATFORM_WORD) -> PLATFORM_STRING -> PLATFORM_WORD+foldl1' = coerce New.foldl1'++-- | 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a `PLATFORM_STRING`,+-- reduces the `PLATFORM_STRING` using the binary operator, from right to left.+--+foldr :: forall a. (PLATFORM_WORD -> a -> a) -> a -> PLATFORM_STRING -> a+foldr = coerce (New.foldr @a)++-- | 'foldr'' is like 'foldr', but strict in the accumulator.+--+foldr'+ :: forall a. (PLATFORM_WORD -> a -> a) -> a -> PLATFORM_STRING -> a+foldr' = coerce (New.foldr' @a)++-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty `PLATFORM_STRING`s+-- An exception will be thrown in the case of an empty `PLATFORM_STRING`.+--+foldr1 :: (PLATFORM_WORD -> PLATFORM_WORD -> PLATFORM_WORD) -> PLATFORM_STRING -> PLATFORM_WORD+foldr1 = coerce New.foldr1++-- | 'foldr1'' is a variant of 'foldr1', but is strict in the+-- accumulator.+--+foldr1'+ :: (PLATFORM_WORD -> PLATFORM_WORD -> PLATFORM_WORD) -> PLATFORM_STRING -> PLATFORM_WORD+foldr1' = coerce New.foldr1'++-- | /O(n)/ Applied to a predicate and a 'PLATFString', 'all' determines+-- if all elements of the `PLATFORM_STRING` satisfy the predicate.+--+all :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> Bool+all = coerce New.all++-- | /O(n)/ Applied to a predicate and a `PLATFORM_STRING`, 'any' determines if+-- any element of the `PLATFORM_STRING` satisfies the predicate.+--+any :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> Bool+any = coerce New.any++-- /O(n)/ Concatenate a list of OsStrings.+--+concat :: [PLATFORM_STRING] -> PLATFORM_STRING+concat = mconcat++-- | /O(n)/ 'replicate' @n x@ is a `PLATFORM_STRING` of length @n@ with @x@+-- the value of every element. The following holds:+--+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c+--+replicate :: Int -> PLATFORM_WORD -> PLATFORM_STRING+replicate = coerce New.replicate++-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a+-- `PLATFORM_STRING` from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the `PLATFORM_STRING` or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,+-- and @b@ is the seed value for further production.+--+-- This function is not efficient/safe. It will build a list of @[Word8]@+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,+-- then finally create a `PLATFORM_STRING`.+--+-- If you know the maximum length, consider using 'unfoldrN'.+--+-- Examples:+--+-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0+-- > == pack [0, 1, 2, 3, 4, 5]+--+unfoldr :: forall a. (a -> Maybe (PLATFORM_WORD, a)) -> a -> PLATFORM_STRING+unfoldr = coerce (New.unfoldr @a)++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a `PLATFORM_STRING` from a seed+-- value. However, the length of the result is limited by the first+-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'+-- when the maximum length of the result is known.+--+-- The following equation relates 'unfoldrN' and 'unfoldr':+--+-- > fst (unfoldrN n f s) == take n (unfoldr f s)+--+unfoldrN :: forall a. Int -> (a -> Maybe (PLATFORM_WORD, a)) -> a -> (PLATFORM_STRING, Maybe a)+unfoldrN = coerce (New.unfoldrN @a)++-- | /O(n)/ 'take' @n@, applied to a `PLATFORM_STRING` @xs@, returns the prefix+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+--+take :: Int -> PLATFORM_STRING -> PLATFORM_STRING+take = coerce New.take++-- | /O(n)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+-- >>> takeEnd 0 "abcdefg"+-- ""+-- >>> takeEnd 4 "abc"+-- "abc"+--+takeEnd :: Int -> PLATFORM_STRING -> PLATFORM_STRING+takeEnd = coerce New.takeEnd++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate.+--+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.+--+takeWhileEnd :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+takeWhileEnd = coerce New.takeWhileEnd++-- | Similar to 'Prelude.takeWhile',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate.+--+takeWhile :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+takeWhile = coerce New.takeWhile++-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or 'empty' if @n > 'length' xs@.+--+drop :: Int -> PLATFORM_STRING -> PLATFORM_STRING+drop = coerce New.drop++-- | /O(n)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "abcdefg"+-- "abcd"+-- >>> dropEnd 0 "abcdefg"+-- "abcdefg"+-- >>> dropEnd 4 "abc"+-- ""+dropEnd :: Int -> PLATFORM_STRING -> PLATFORM_STRING+dropEnd = coerce New.dropEnd++-- | Similar to 'Prelude.dropWhile',+-- drops the longest (possibly empty) prefix of elements+-- satisfying the predicate and returns the remainder.+dropWhile :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+dropWhile = coerce New.dropWhile++-- | Similar to 'Prelude.dropWhileEnd',+-- drops the longest (possibly empty) suffix of elements+-- satisfying the predicate and returns the remainder.+--+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.+dropWhileEnd :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+dropWhileEnd = coerce New.dropWhileEnd++-- | Returns the longest (possibly empty) suffix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+breakEnd :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+breakEnd = coerce New.breakEnd++-- | Similar to 'Prelude.break',+-- returns the longest (possibly empty) prefix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.+break :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+break = coerce New.break++-- | Similar to 'Prelude.span',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.+span :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+span = coerce New.span++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+--+-- We have+--+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")+--+-- and+--+-- > spanEnd (not . isSpace) sbs+-- > ==+-- > let (x, y) = span (not . isSpace) (reverse sbs) in (reverse y, reverse x)+--+spanEnd :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+spanEnd = coerce New.spanEnd++-- | /O(n)/ 'splitAt' @n sbs@ is equivalent to @('take' n sbs, 'drop' n sbs)@.+splitAt :: Int -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+splitAt = coerce New.splitAt++-- | /O(n)/ Break a `PLATFORM_STRING` into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120+-- > split undefined "" == [] -- and not [""]+--+-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+--+split :: PLATFORM_WORD -> PLATFORM_STRING -> [PLATFORM_STRING]+split = coerce New.split++-- | /O(n)/ Splits a `PLATFORM_STRING` into components delimited by+-- separators, where the predicate returns True for a separator element.+-- The resulting components do not contain the separators. Two adjacent+-- separators result in an empty component in the output. eg.+--+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith undefined "" == [] -- and not [""]+--+splitWith :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> [PLATFORM_STRING]+splitWith = coerce New.splitWith++-- | /O(n)/ The 'stripSuffix' function takes two OsStrings and returns 'Just'+-- the remainder of the second iff the first is its suffix, and otherwise+-- 'Nothing'.+stripSuffix :: PLATFORM_STRING -> PLATFORM_STRING -> Maybe PLATFORM_STRING+stripSuffix = coerce New.stripSuffix++-- | /O(n)/ The 'stripPrefix' function takes two OsStrings and returns 'Just'+-- the remainder of the second iff the first is its prefix, and otherwise+-- 'Nothing'.+stripPrefix :: PLATFORM_STRING -> PLATFORM_STRING -> Maybe PLATFORM_STRING+stripPrefix = coerce New.stripPrefix+++-- | Check whether one string is a substring of another.+isInfixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isInfixOf = coerce New.isInfixOf++-- |/O(n)/ The 'isPrefixOf' function takes two OsStrings and returns 'True'+isPrefixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isPrefixOf = coerce New.isPrefixOf++-- | /O(n)/ The 'isSuffixOf' function takes two OsStrings and returns 'True'+-- iff the first is a suffix of the second.+--+-- The following holds:+--+-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y+--+isSuffixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isSuffixOf = coerce New.isSuffixOf+++-- | Break a string on a substring, returning a pair of the part of the+-- string prior to the match, and the rest of the string.+--+-- The following relationships hold:+--+-- > break (== c) l == breakSubstring (singleton c) l+--+-- For example, to tokenise a string, dropping delimiters:+--+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)+-- > where (h,t) = breakSubstring x y+--+-- To skip to the first occurrence of a string:+--+-- > snd (breakSubstring x y)+--+-- To take the parts of a string before a delimiter:+--+-- > fst (breakSubstring x y)+--+-- Note that calling `breakSubstring x` does some preprocessing work, so+-- you should avoid unnecessarily duplicating breakSubstring calls with the same+-- pattern.+breakSubstring :: PLATFORM_STRING -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+breakSubstring = coerce New.breakSubstring++-- | /O(n)/ 'elem' is the `PLATFORM_STRING` membership predicate.+elem :: PLATFORM_WORD -> PLATFORM_STRING -> Bool+elem = coerce New.elem++-- | /O(n)/ The 'find' function takes a predicate and a `PLATFORM_STRING`,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+--+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing+--+find :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> Maybe PLATFORM_WORD+find = coerce New.find++-- | /O(n)/ 'filter', applied to a predicate and a `PLATFORM_STRING`,+-- returns a `PLATFORM_STRING` containing those characters that satisfy the+-- predicate.+filter :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+filter = coerce New.filter++-- | /O(n)/ The 'partition' function takes a predicate a `PLATFORM_STRING` and returns+-- the pair of OsStrings with elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p bs == (filter p sbs, filter (not . p) sbs)+--+partition :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> (PLATFORM_STRING, PLATFORM_STRING)+partition = coerce New.partition++-- | /O(1)/ `PLATFORM_STRING` index (subscript) operator, starting from 0.+index :: HasCallStack => PLATFORM_STRING -> Int -> PLATFORM_WORD+index = coerce New.index++-- | /O(1)/ `PLATFORM_STRING` index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+indexMaybe :: PLATFORM_STRING -> Int -> Maybe PLATFORM_WORD+indexMaybe = coerce New.indexMaybe++-- | /O(1)/ `PLATFORM_STRING` index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+(!?) :: PLATFORM_STRING -> Int -> Maybe PLATFORM_WORD+(!?) = indexMaybe++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given `PLATFORM_STRING` which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: PLATFORM_WORD -> PLATFORM_STRING -> Maybe Int+elemIndex = coerce New.elemIndex++-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning+-- the indices of all elements equal to the query element, in ascending order.+elemIndices :: PLATFORM_WORD -> PLATFORM_STRING -> [Int]+elemIndices = coerce New.elemIndices++-- | count returns the number of times its argument appears in the `PLATFORM_STRING`+count :: PLATFORM_WORD -> PLATFORM_STRING -> Int+count = coerce New.count++-- | /O(n)/ The 'findIndex' function takes a predicate and a `PLATFORM_STRING` and+-- returns the index of the first element in the `PLATFORM_STRING`+-- satisfying the predicate.+findIndex :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> Maybe Int+findIndex = coerce New.findIndex++-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending order.+--+findIndices :: (PLATFORM_WORD -> Bool) -> PLATFORM_STRING -> [Int]+findIndices = coerce New.findIndices++#endif
+ test/Arbitrary.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -Wno-orphans #-} + +-- Taken from https://github.com/haskell/os-string + +module Arbitrary where + +import Data.Char +import Data.Maybe +import System.OsString.Compat +import System.OsString.Internal.Types.Compat +import System.OsString.Posix.Compat qualified as Posix +import System.OsString.Windows.Compat qualified as Windows +import Data.ByteString ( ByteString ) +import Data.ByteString qualified as ByteString +import Test.QuickCheck + + +instance Arbitrary OsString where + arbitrary = fmap fromJust $ encodeUtf <$> listOf filepathChar + +instance Arbitrary PosixString where + arbitrary = fmap fromJust $ Posix.encodeUtf <$> listOf filepathChar + +instance Arbitrary WindowsString where + arbitrary = fmap fromJust $ Windows.encodeUtf <$> listOf filepathChar + + +newtype NonNullString = NonNullString { nonNullString :: String } + deriving Show + +instance Arbitrary NonNullString where + arbitrary = NonNullString <$> listOf filepathChar + +filepathChar :: Gen Char +filepathChar = arbitraryUnicodeChar `suchThat` (\c -> not (isNull c) && isValidUnicode c) + where + isNull = (== '\NUL') + isValidUnicode c = case generalCategory c of + Surrogate -> False + NotAssigned -> False + _ -> True + + +newtype NonNullAsciiString = NonNullAsciiString { nonNullAsciiString :: String } + deriving Show + +instance Arbitrary NonNullAsciiString where + arbitrary = NonNullAsciiString <$> listOf filepathAsciiChar + +filepathAsciiChar :: Gen Char +filepathAsciiChar = arbitraryASCIIChar `suchThat` (\c -> not (isNull c)) + where + isNull = (== '\NUL') + +newtype NonNullSurrogateString = NonNullSurrogateString { nonNullSurrogateString :: String } + deriving Show + +instance Arbitrary NonNullSurrogateString where + arbitrary = NonNullSurrogateString <$> listOf filepathWithSurrogates + +filepathWithSurrogates :: Gen Char +filepathWithSurrogates = + frequency + [(3, arbitraryASCIIChar), + (1, arbitraryUnicodeChar), + (1, arbitraryBoundedEnum) + ] + + +instance Arbitrary ByteString where arbitrary = ByteString.pack <$> arbitrary +instance CoArbitrary ByteString where coarbitrary = coarbitrary . ByteString.unpack
+ test/TestUtil.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- Again, taken from os-string + +module TestUtil( + module TestUtil, + module Test.QuickCheck, + module Data.List, + module Data.Maybe + ) where + +import Test.QuickCheck hiding ((==>)) +import Data.List +import Data.Maybe +import Control.Monad +import System.Environment + +infixr 0 ==> +(==>) :: Bool -> Bool -> Bool +a ==> b = not a || b + +runTests :: [(String, Property)] -> IO () +runTests tests = do + args <- getArgs + let count = case args of i:_ -> read i; _ -> 10000 + let testNum = case args of + _:i:_ + | let num = read i + , num < 0 -> drop (negate num) tests + | let num = read i + , num > 0 -> take num tests + | otherwise -> [] + _ -> tests + putStrLn $ "Testing with " ++ show count ++ " repetitions" + let total' = length testNum + let showOutput x = show x{output=""} ++ "\n" ++ output x + bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do + putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg + res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop + case res of + Success{} -> pure Nothing + bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad) + if null bad then + putStrLn $ "Success, " ++ show total' ++ " tests passed" + else do + putStrLn $ show (length bad) ++ " FAILURES\n" + forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) -> + putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n" + fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
+ test/bytestring/Properties/OsString.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-} +#undef WORD16 +#undef POSIX +#undef WIN +#define OSWORD +#include "include/Common.hs"
+ test/bytestring/Properties/PosixString.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}+#undef WORD16+#define POSIX+#undef WIN+#undef OSWORD+#include "include/Common.hs"
+ test/bytestring/Properties/ShortByteString.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-} +#undef WORD16 +#undef WIN +#undef POSIX +#undef OSWORD +#include "include/Common.hs"
+ test/bytestring/Properties/ShortByteString/Word16.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-} +#define WORD16 +#undef WIN +#undef POSIX +#undef OSWORD +#include "../include/Common.hs"
+ test/bytestring/Properties/WindowsString.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-} +#define WORD16 +#define WIN +#undef POSIX +#undef OSWORD +#include "include/Common.hs"
+ test/bytestring/Properties/include/Common.hs view
@@ -0,0 +1,653 @@+-- | +-- Module : Properties.ShortByteString +-- Copyright : (c) Andrew Lelechenko 2021 +-- License : BSD-style + +-- Again, copied from os-string code. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- We are happy to sacrifice optimizations in exchange for faster compilation, +-- but need to test rewrite rules. As one can check using -ddump-rule-firings, +-- rewrite rules do not fire in -O0 mode, so we use -O1, but disable almost all +-- optimizations. It roughly halves compilation time. +{-# OPTIONS_GHC -O1 -fenable-rewrite-rules + -fmax-simplifier-iterations=1 -fsimplifier-phases=0 + -fno-call-arity -fno-case-merge -fno-cmm-elim-common-blocks -fno-cmm-sink + -fno-cpr-anal -fno-cse -fno-do-eta-reduction -fno-float-in -fno-full-laziness + -fno-loopification -fno-specialise -fno-strictness -Wno-unused-imports -Wno-unused-top-binds #-} + +#ifdef OSWORD +module Properties.OsString (tests) where +import System.OsString.Internal.Types.Compat (OsString(..), OsChar(..), getOsChar) +import System.OsString.Compat qualified as B +import System.OsString.Compat qualified as BS +import "os-string" System.OsString.Data.ByteString.Short.Internal qualified as BSI (_nul, isSpace) + +#else + +#ifdef WORD16 +#ifdef WIN +module Properties.WindowsString (tests) where +import System.OsString.Windows.Compat qualified as B +import System.OsString.Windows.Compat qualified as BS +#else +module Properties.ShortByteString.Word16 (tests) where +import "os-string" System.OsString.Data.ByteString.Short.Internal (_nul, isSpace) +import "os-string" System.OsString.Data.ByteString.Short.Word16 qualified as B +import "os-string" System.OsString.Data.ByteString.Short qualified as BS +#endif +#else +#ifdef POSIX +module Properties.PosixString (tests) where +import System.OsString.Posix.Compat qualified as B +import System.OsString.Posix.Compat qualified as BS +#else +module Properties.ShortByteString (tests) where +import "os-string" System.OsString.Data.ByteString.Short qualified as B +#endif +#endif +#endif + +import Data.ByteString.Short (ShortByteString) + +import Data.Char qualified as C +import "os-string" System.OsString.Data.ByteString.Short.Word16 qualified as B16 +import "os-string" System.OsString.Data.ByteString.Short qualified as B8 + +import Data.Word + +import Control.Arrow +import Data.Coerce (coerce) +import Data.Type.Coercion (Coercion(..), coerceWith, sym) +import Data.Foldable +import Data.List as L +import Data.Semigroup +import Data.Tuple +import Test.QuickCheck +import Test.QuickCheck.Monadic ( monadicIO, run ) +import Text.Show.Functions () + +import System.OsString.Internal.Types.Compat (WindowsString(..), WindowsChar(..), getWindowsChar, PosixChar(..), PosixString(..), getPosixChar, OsString(..), OsChar(..), getOsChar) +import System.OsString.Posix.Compat qualified as PBS +import System.OsString.Windows.Compat qualified as WBS +import System.OsString.Compat qualified as OBS +import "os-string" System.OsString.Data.ByteString.Short.Internal qualified as BSI (_nul, isSpace) + + +instance Arbitrary PosixString where + arbitrary = do + bs <- sized sizedByteString' + n <- choose (0, 2) + return (PBS.drop n bs) -- to give us some with non-0 offset + where + sizedByteString' :: Int -> Gen PosixString + sizedByteString' n = do m <- choose(0, n) + fmap (PosixString . B8.pack) $ vectorOf m arbitrary + +instance Arbitrary PosixChar where + arbitrary = fmap PosixChar (arbitrary @Word8) + +instance CoArbitrary PosixChar where + coarbitrary s = coarbitrary (PBS.toChar s) + +instance CoArbitrary PosixString where + coarbitrary s = coarbitrary (PBS.unpack s) + +deriving instance Num PosixChar + +deriving instance Bounded PosixChar + +instance Arbitrary WindowsString where + arbitrary = do + bs <- sized sizedByteString' + n <- choose (0, 2) + return (WBS.drop n bs) -- to give us some with non-0 offset + where + sizedByteString' :: Int -> Gen WindowsString + sizedByteString' n = do m <- choose(0, n) + fmap (WindowsString . B16.pack) $ vectorOf m arbitrary + +instance Arbitrary WindowsChar where + arbitrary = fmap WindowsChar (arbitrary @Word16) + +instance CoArbitrary WindowsChar where + coarbitrary s = coarbitrary (WBS.toChar s) + +instance CoArbitrary WindowsString where + coarbitrary s = coarbitrary (WBS.unpack s) + +deriving instance Num WindowsChar + +deriving instance Bounded WindowsChar + +isSpaceWin :: WindowsChar -> Bool +isSpaceWin = BSI.isSpace . getWindowsChar + +numWordWin :: WindowsString -> Int +numWordWin = B16.numWord16 . getWindowsString + + +swapWWin :: WindowsChar -> WindowsChar +swapWWin = WindowsChar . byteSwap16 . getWindowsChar + +isSpacePosix :: PosixChar -> Bool +isSpacePosix = C.isSpace . word8ToChar . getPosixChar + +numWordPosix :: PosixString -> Int +numWordPosix = B8.length . getPosixString + + +swapWPosix :: PosixChar -> PosixChar +swapWPosix = id + +#ifdef OSWORD +isSpace :: OsChar -> Bool +isSpace = case OBS.coercionToPlatformTypes of + Left (co, _) -> isSpaceWin . coerceWith co + Right (co, _) -> isSpacePosix . coerceWith co + +numWord :: OsString -> Int +numWord = case OBS.coercionToPlatformTypes of + Left (_, co) -> numWordWin . coerceWith co + Right (_, co) -> numWordPosix . coerceWith co + +toElem :: OsChar -> OsChar +toElem = id + +swapW :: OsChar -> OsChar +swapW = case OBS.coercionToPlatformTypes of + Left (co, _) -> coerceWith (sym co) . swapWWin . coerceWith co + Right (co, _) -> coerceWith (sym co) . swapWPosix . coerceWith co + +instance Arbitrary OsString where + arbitrary = OsString <$> arbitrary + +instance Arbitrary OsChar where + arbitrary = OsChar <$> arbitrary + +instance CoArbitrary OsChar where + coarbitrary s = coarbitrary (OBS.toChar s) + +instance CoArbitrary OsString where + coarbitrary s = coarbitrary (OBS.unpack s) + +deriving instance Num OsChar +deriving instance Bounded OsChar + +instance Arbitrary ShortByteString where + arbitrary = case OBS.coercionToPlatformTypes of + Left (_, _) -> getWindowsString <$> arbitrary + Right (_, _) -> getPosixString <$> arbitrary + +#else + +#ifdef WORD16 + +instance Arbitrary ShortByteString where + arbitrary = do + bs <- sized sizedByteString + n <- choose (0, 2) + return (B16.drop n bs) -- to give us some with non-0 offset + where + sizedByteString :: Int -> Gen ShortByteString + sizedByteString n = do m <- choose(0, n) + fmap B16.pack $ vectorOf m arbitrary + +instance CoArbitrary ShortByteString where + coarbitrary s = coarbitrary (B16.unpack s) +#ifdef WIN + +isSpace :: WindowsChar -> Bool +isSpace = isSpaceWin + +numWord :: WindowsString -> Int +numWord = numWordWin + +toElem :: WindowsChar -> WindowsChar +toElem = id + +swapW :: WindowsChar -> WindowsChar +swapW = swapWWin + +#else +numWord :: ShortByteString -> Int +numWord = B.numWord16 + +toElem :: Word16 -> Word16 +toElem = id + +swapW :: Word16 -> Word16 +swapW = byteSwap16 + + +#endif +#else +#ifdef POSIX + +isSpace :: PosixChar -> Bool +isSpace = isSpacePosix + +numWord :: PosixString -> Int +numWord = numWordPosix + +toElem :: PosixChar -> PosixChar +toElem = id + +swapW :: PosixChar -> PosixChar +swapW = swapWPosix + +#else +_nul :: Word8 +_nul = 0x00 + +isSpace :: Word8 -> Bool +isSpace = C.isSpace . word8ToChar + + +numWord :: ShortByteString -> Int +numWord = B8.length + +toElem :: Word8 -> Word8 +toElem = id + +swapW :: Word8 -> Word8 +swapW = id + + + +#endif + +instance Arbitrary ShortByteString where + arbitrary = do + bs <- sized sizedByteString' + n <- choose (0, 2) + return (B8.drop n bs) -- to give us some with non-0 offset + where + sizedByteString' :: Int -> Gen ShortByteString + sizedByteString' n = do m <- choose(0, n) + fmap B8.pack $ vectorOf m arbitrary + shrink = map B8.pack . shrink . B8.unpack + +instance CoArbitrary ShortByteString where + coarbitrary s = coarbitrary (B8.unpack s) +#endif +#endif + + +tests :: [(String, Property)] +tests = + [ ("pack . unpack", + property $ \x -> x === B.pack (B.unpack x)) + , ("unpack . pack" , + property $ \(map toElem -> xs) -> xs === B.unpack (B.pack xs)) + , ("read . show" , + property $ \x -> (x :: ShortByteString) === read (show x)) + + , ("==" , + property $ \x y -> (x == y) === (B.unpack x == B.unpack y)) + , ("== refl" , + property $ \x -> (x :: ShortByteString) == x) + , ("== symm", + property $ \x y -> ((x :: ShortByteString) == y) === (y == x)) + , ("== pack unpack", + property $ \x -> x == B.pack (B.unpack x)) + + , ("compare", + property $ \x y -> compare x y === compare (swapW <$> B.unpack x) (swapW <$> B.unpack y)) + , ("compare EQ", + property $ \x -> compare (x :: ShortByteString) x == EQ) + , ("compare GT", + property $ \x (toElem -> c) -> compare (B.snoc x c) x == GT) + , ("compare LT", + property $ \x (toElem -> c) -> compare x (B.snoc x c) == LT) + , ("compare GT empty", + property $ \x -> not (B.null x) ==> compare x B.empty == GT) + , ("compare LT empty", + property $ \x -> not (B.null x) ==> compare B.empty x == LT) + , ("compare GT concat", + property $ \x y -> not (B.null y) ==> compare (x `mappend` y) x == GT) + , ("compare char" , + property $ \(toElem -> c) (toElem -> d) -> compare (swapW c) (swapW d) == compare (B.singleton c) (B.singleton d)) + , ("compare unsigned", + once $ compare (B.singleton 255) (B.singleton 127) == GT) + + , ("null" , + property $ \x -> B.null x === null (B.unpack x)) + , ("empty 0" , + once $ numWord B.empty === 0) + , ("empty []", + once $ B.unpack B.empty === []) + , ("mempty 0", + once $ numWord mempty === 0) + , ("mempty []", + once $ B.unpack mempty === []) + +#ifdef WORD16 +#ifdef WIN + , ("isInfixOf works correctly under UTF16", + once $ + let foo = WindowsString $ B8.pack [0xbb, 0x03] + foo' = WindowsString $ B8.pack [0xd2, 0xbb] + bar = WindowsString $ B8.pack [0xd2, 0xbb, 0x03, 0xad] + bar' = WindowsString $ B8.pack [0xd2, 0xbb, 0x03, 0xad, 0xd2, 0xbb, 0x03, 0xad, 0xbb, 0x03, 0x00, 0x00] + in [B.isInfixOf foo bar, B.isInfixOf foo' bar, B.isInfixOf foo bar'] === [False, True, True] + ) +#else + , ("isInfixOf works correctly under UTF16", + once $ + let foo = BS.pack [0xbb, 0x03] + foo' = BS.pack [0xd2, 0xbb] + bar = BS.pack [0xd2, 0xbb, 0x03, 0xad] + bar' = BS.pack [0xd2, 0xbb, 0x03, 0xad, 0xd2, 0xbb, 0x03, 0xad, 0xbb, 0x03, 0x00, 0x00] + in [B.isInfixOf foo bar, B.isInfixOf foo' bar, B.isInfixOf foo bar'] === [False, True, True] + ) +#endif +#endif + , ("break breakSubstring", + property $ \(toElem -> c) x -> B.break (== c) x === B.breakSubstring (B.singleton c) x + ) + , ("breakSubstring", + property $ \x y -> not (B.null x) ==> B.null (snd (B.breakSubstring x y)) === not (B.isInfixOf x y) + ) + , ("breakSubstring empty", + property $ \x -> B.breakSubstring B.empty x === (B.empty, x) + ) + , ("isInfixOf", + property $ \x y -> B.isInfixOf x y === L.isInfixOf (B.unpack x) (B.unpack y)) + + , ("mconcat" , + property $ \xs -> B.unpack (mconcat xs) === mconcat (map B.unpack xs)) + , ("mconcat [x,x]" , + property $ \x -> B.unpack (mconcat [x, x]) === mconcat [B.unpack x, B.unpack x]) + , ("mconcat [x,[]]" , + property $ \x -> B.unpack (mconcat [x, B.empty]) === mconcat [B.unpack x, []]) + + , ("null" , + property $ \x -> B.null x === null (B.unpack x)) + , ("reverse" , + property $ \x -> B.unpack (B.reverse x) === reverse (B.unpack x)) + , ("all" , + property $ \f x -> B.all f x === all f (B.unpack x)) + , ("all ==" , + property $ \(toElem -> c) x -> B.all (== c) x === all (== c) (B.unpack x)) + , ("any" , + property $ \f x -> B.any f x === any f (B.unpack x)) + , ("any ==" , + property $ \(toElem -> c) x -> B.any (== c) x === any (== c) (B.unpack x)) + , ("mappend" , + property $ \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y) + , ("<>" , + property $ \x y -> B.unpack (x `mappend` y) === B.unpack x `mappend` B.unpack y) + , ("stimes" , + property $ \(Positive n) x -> stimes (n :: Int) (x :: ShortByteString) === mtimesDefault n x) + + , ("break" , + property $ \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)) + , ("break ==" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (== c) x) === break (== c) (B.unpack x)) + , ("break /=" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.break (/= c) x) === break (/= c) (B.unpack x)) + , ("break span" , + property $ \f x -> B.break f x === B.span (not . f) x) + , ("breakEnd" , + property $ \f x -> B.breakEnd f x === swap ((B.reverse *** B.reverse) (B.break f (B.reverse x)))) + , ("breakEnd" , + property $ \f x -> B.breakEnd f x === B.spanEnd (not . f) x) + , ("break isSpace" , + property $ \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x)) + + , ("singleton" , + property $ \(toElem -> c) -> B.unpack (B.singleton c) === [c]) + , ("cons" , + property $ \(toElem -> c) x -> B.unpack (B.cons c x) === c : B.unpack x) + , ("cons []" , + property $ \(toElem -> c) -> B.unpack (B.cons c B.empty) === [c]) + , ("uncons" , + property $ \x -> fmap (second B.unpack) (B.uncons x) === L.uncons (B.unpack x)) + , ("snoc" , + property $ \(toElem -> c) x -> B.unpack (B.snoc x c) === B.unpack x ++ [c]) + , ("snoc []" , + property $ \(toElem -> c) -> B.unpack (B.snoc B.empty c) === [c]) + , ("unsnoc" , + property $ \x -> fmap (first B.unpack) (B.unsnoc x) === unsnoc (B.unpack x)) + + , ("drop" , + property $ \n x -> B.unpack (B.drop n x) === drop (fromIntegral n) (B.unpack x)) + , ("drop 10" , + property $ \x -> B.unpack (B.drop 10 x) === drop 10 (B.unpack x)) + , ("dropWhile" , + property $ \f x -> B.unpack (B.dropWhile f x) === dropWhile f (B.unpack x)) + , ("dropWhile ==" , + property $ \(toElem -> c) x -> B.unpack (B.dropWhile (== c) x) === dropWhile (== c) (B.unpack x)) + , ("dropWhile /=" , + property $ \(toElem -> c) x -> B.unpack (B.dropWhile (/= c) x) === dropWhile (/= c) (B.unpack x)) + , ("dropWhile isSpace" , + property $ \x -> B.unpack (B.dropWhile isSpace x) === dropWhile isSpace (B.unpack x)) + + , ("take" , + property $ \n x -> B.unpack (B.take n x) === take (fromIntegral n) (B.unpack x)) + , ("take 10" , + property $ \x -> B.unpack (B.take 10 x) === take 10 (B.unpack x)) + , ("takeWhile" , + property $ \f x -> B.unpack (B.takeWhile f x) === takeWhile f (B.unpack x)) + , ("takeWhile ==" , + property $ \(toElem -> c) x -> B.unpack (B.takeWhile (== c) x) === takeWhile (== c) (B.unpack x)) + , ("takeWhile /=" , + property $ \(toElem -> c) x -> B.unpack (B.takeWhile (/= c) x) === takeWhile (/= c) (B.unpack x)) + + , ("takeWhile isSpace" , + property $ \x -> B.unpack (B.takeWhile isSpace x) === takeWhile isSpace (B.unpack x)) + + , ("dropEnd" , + property $ \n x -> B.dropEnd n x === B.take (numWord x - n) x) + , ("dropWhileEnd" , + property $ \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x))) + , ("takeEnd" , + property $ \n x -> B.takeEnd n x === B.drop (numWord x - n) x) + , ("takeWhileEnd" , + property $ \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))) + + , ("length" , + property $ \x -> numWord x === fromIntegral (length (B.unpack x))) +#if defined(OSWORD) || defined(WIN) || defined(POSIX) + , ("length abc" , + once $ B.length (B.pack [0xbb, 0x03]) == 2) +#endif +#if defined(POSIX) + , ("length in bytes (UTF-8)" , + once $ B.lengthBytes (B.pack [0xbb, 0x03]) == 2) +#elif defined(WIN) || (defined(OSWORD) && defined(mingw32_HOST_OS)) + , ("length in bytes (UTF-16)" , + once $ B.lengthBytes (B.pack [0xbb, 0x03]) == 4) +#elif defined(OSWORD) + , ("length in bytes (UTF-8)" , + once $ B.lengthBytes (B.pack [0xbb, 0x03]) == 2) +#endif + , ("count" , + property $ \(toElem -> c) x -> B.count c x === fromIntegral (length (elemIndices c (B.unpack x)))) + , ("filter" , + property $ \f x -> B.unpack (B.filter f x) === filter f (B.unpack x)) + , ("filter compose" , + property $ \f g x -> B.filter f (B.filter g x) === B.filter (\c -> f c && g c) x) + , ("filter ==" , + property $ \(toElem -> c) x -> B.unpack (B.filter (== c) x) === filter (== c) (B.unpack x)) + , ("filter /=" , + property $ \(toElem -> c) x -> B.unpack (B.filter (/= c) x) === filter (/= c) (B.unpack x)) + , ("partition" , + property $ \f x -> (B.unpack *** B.unpack) (B.partition f x) === partition f (B.unpack x)) + + , ("find" , + property $ \f x -> B.find f x === find f (B.unpack x)) + , ("findIndex" , + property $ \f x -> B.findIndex f x === fmap fromIntegral (findIndex f (B.unpack x))) + , ("findIndices" , + property $ \f x -> B.findIndices f x === fmap fromIntegral (findIndices f (B.unpack x))) + , ("findIndices ==" , + property $ \(toElem -> c) x -> B.findIndices (== c) x === fmap fromIntegral (findIndices (== c) (B.unpack x))) + + , ("elem" , + property $ \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)) + , ("not elem" , + property $ \(toElem -> c) x -> not (B.elem c x) === notElem c (B.unpack x)) + , ("elemIndex" , + property $ \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (elemIndex c (B.unpack x))) + , ("elemIndices" , + property $ \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (elemIndices c (B.unpack x))) + + + , ("map" , + property $ \f x -> B.unpack (B.map (toElem . f) x) === map (toElem . f) (B.unpack x)) + , ("map compose" , + property $ \f g x -> B.map (toElem . f) (B.map (toElem . g) x) === B.map (toElem . f . toElem . g) x) + , ("replicate" , + property $ \n (toElem -> c) -> B.unpack (B.replicate (fromIntegral n) c) === replicate n c) + , ("replicate 0" , + property $ \(toElem -> c) -> B.unpack (B.replicate 0 c) === replicate 0 c) + + , ("span" , + property $ \f x -> (B.unpack *** B.unpack) (B.span f x) === span f (B.unpack x)) + , ("span ==" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (== c) x) === span (== c) (B.unpack x)) + , ("span /=" , + property $ \(toElem -> c) x -> (B.unpack *** B.unpack) (B.span (/= c) x) === span (/= c) (B.unpack x)) + , ("spanEnd" , + property $ \f x -> B.spanEnd f x === swap ((B.reverse *** B.reverse) (B.span f (B.reverse x)))) + , ("split" , + property $ \(toElem -> c) x -> map B.unpack (B.split c x) === split c (B.unpack x)) + , ("split empty" , + property $ \(toElem -> c) -> B.split c B.empty === []) + , ("splitWith" , + property $ \f x -> map B.unpack (B.splitWith f x) === splitWith f (B.unpack x)) + , ("splitWith split" , + property $ \(toElem -> c) x -> B.splitWith (== c) x === B.split c x) + , ("splitWith empty" , + property $ \f -> B.splitWith f B.empty === []) + , ("splitWith length" , + property $ \f x -> let splits = B.splitWith f x; l1 = fromIntegral (length splits); l2 = numWord (B.filter f x) in + (l1 == l2 || l1 == l2 + 1) && sum (map numWord splits) + l2 == numWord x) + , ("splitAt" , + property $ \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === splitAt (fromIntegral n) (B.unpack x)) + + , ("head" , + property $ \x -> not (B.null x) ==> B.head x == head (B.unpack x)) + , ("last" , + property $ \x -> not (B.null x) ==> B.last x == last (B.unpack x)) + , ("tail" , + property $ \x -> not (B.null x) ==> B.unpack (B.tail x) == tail (B.unpack x)) + , ("tail length" , + property $ \x -> not (B.null x) ==> numWord x == 1 + numWord (B.tail x)) + , ("init" , + property $ \x -> not (B.null x) ==> B.unpack (B.init x) == init (B.unpack x)) + , ("init length" , + property $ \x -> not (B.null x) ==> numWord x == 1 + numWord (B.init x)) + + , ("foldl" , + property $ \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)) + , ("foldl'" , + property $ \f (toElem -> c) x -> B.foldl' ((toElem .) . f) c x === foldl' ((toElem .) . f) c (B.unpack x)) + , ("foldr" , + property $ \f (toElem -> c) x -> B.foldr ((toElem .) . f) c x === foldr ((toElem .) . f) c (B.unpack x)) + , ("foldr'" , + property $ \f (toElem -> c) x -> B.foldr' ((toElem .) . f) c x === foldr' ((toElem .) . f) c (B.unpack x)) + + , ("foldl cons" , + property $ \x -> B.foldl (flip B.cons) B.empty x === B.reverse x) + , ("foldr cons" , + property $ \x -> B.foldr B.cons B.empty x === x) + , ("foldl special" , + property $ \x (toElem -> c) -> B.unpack (B.foldl (\acc t -> if t == c then acc else B.cons t acc) B.empty x) === + foldl (\acc t -> if t == c then acc else t : acc) [] (B.unpack x)) + , ("foldr special" , + property $ \x (toElem -> c) -> B.unpack (B.foldr (\t acc -> if t == c then acc else B.cons t acc) B.empty x) === + foldr (\t acc -> if t == c then acc else t : acc) [] (B.unpack x)) + + , ("foldl1" , + property $ \f x -> not (B.null x) ==> B.foldl1 ((toElem .) . f) x == foldl1 ((toElem .) . f) (B.unpack x)) + , ("foldl1'" , + property $ \f x -> not (B.null x) ==> B.foldl1' ((toElem .) . f) x == foldl1' ((toElem .) . f) (B.unpack x)) + , ("foldr1" , + property $ \f x -> not (B.null x) ==> B.foldr1 ((toElem .) . f) x == foldr1 ((toElem .) . f) (B.unpack x)) + , ("foldr1'", -- there is not Data.List.foldr1' + property $ \f x -> not (B.null x) ==> B.foldr1' ((toElem .) . f) x == foldr1 ((toElem .) . f) (B.unpack x)) + + , ("foldl1 const" , + property $ \x -> not (B.null x) ==> B.foldl1 const x == B.head x) + , ("foldl1 flip const" , + property $ \x -> not (B.null x) ==> B.foldl1 (flip const) x == B.last x) + , ("foldr1 const" , + property $ \x -> not (B.null x) ==> B.foldr1 const x == B.head x) + , ("foldr1 flip const" , + property $ \x -> not (B.null x) ==> B.foldr1 (flip const) x == B.last x) + , ("foldl1 max" , + property $ \x -> not (B.null x) ==> B.foldl1 max x == B.foldl max minBound x) + , ("foldr1 max" , + property $ \x -> not (B.null x) ==> B.foldr1 max x == B.foldr max minBound x) + + , ("index" , + property $ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.index x (fromIntegral n) == B.unpack x !! n) + , ("indexMaybe" , + property $ \(NonNegative n) x -> fromIntegral n < numWord x ==> B.indexMaybe x (fromIntegral n) == Just (B.unpack x !! n)) + , ("indexMaybe Nothing" , + property $ \n x -> (n :: Int) < 0 || fromIntegral n >= numWord x ==> B.indexMaybe x (fromIntegral n) == Nothing) + , ("!?" , + property $ \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)) + + , ("unfoldrN" , + property $ \n f (toElem -> c) -> B.unpack (fst (B.unfoldrN n (fmap (first toElem) . f) c)) === + take (fromIntegral n) (unfoldr (fmap (first toElem) . f) c)) + , ("unfoldrN replicate" , + property $ \n (toElem -> c) -> fst (B.unfoldrN n (\t -> Just (t, t)) c) === B.replicate n c) + , ("unfoldr" , + property $ \n a (toElem -> c) -> B.unpack (B.unfoldr (\x -> if x <= 100 * n then Just (c, x + 1 :: Int) else Nothing) a) === + unfoldr (\x -> if x <= 100 * n then Just (c, x + 1) else Nothing) a) + + --, ("unfoldr" , + -- property $ \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) === + -- take n (unfoldr (fmap (first toElem) . f) a)) + -- +#if defined(WORD16) && !defined(WIN) && !defined(OSWORD) && !defined(POSIX) + , ("useAsCWString str packCWString == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCWString x B.packCWString >>= \x' -> pure (x == x'))) + , ("useAsCWStringLen str packCWStringLen == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCWStringLen x B.packCWStringLen >>= \x' -> pure (x == x'))) +#endif +#if !defined(WORD16) && !defined(WIN) && !defined(OSWORD) && !defined(POSIX) + , ("useAsCString str packCString == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCString x B.packCString >>= \x' -> pure (x == x'))) + , ("useAsCStringLen str packCStringLen == str" , + property $ \x -> not (B.any (== _nul) x) + ==> monadicIO $ run (B.useAsCStringLen x B.packCStringLen >>= \x' -> pure (x == x'))) +#endif + ] + +split :: Eq a => a -> [a] -> [[a]] +split c = splitWith (== c) + +splitWith :: (a -> Bool) -> [a] -> [[a]] +splitWith _ [] = [] +splitWith f ys = go [] ys + where + go acc [] = [reverse acc] + go acc (x : xs) + | f x = reverse acc : go [] xs + | otherwise = go (x : acc) xs + +#if !MIN_VERSION_base(4, 19, 0) +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc xs = Just (init xs, last xs) +#endif + +-- | Total conversion to char. +word8ToChar :: Word8 -> Char +word8ToChar = C.chr . fromIntegral
+ test/bytestring/Spec.hs view
@@ -0,0 +1,13 @@+-- Copied from https://github.com/haskell/os-string/++module Main (main) where++import qualified Properties.OsString as PropOs+import qualified Properties.PosixString as PropPos+import qualified Properties.WindowsString as PropWin+import qualified Properties.ShortByteString as PropSBS+import qualified Properties.ShortByteString.Word16 as PropSBSW16+import TestUtil++main :: IO ()+main = runTests (PropSBS.tests ++ PropSBSW16.tests ++ PropWin.tests ++ PropPos.tests ++ PropOs.tests)
+ test/encoding/EncodingSpec.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-- {-# LANGUAGE TypeApplications #-} + +-- Again, taken from os-string. + +module EncodingSpec where + +import Data.ByteString ( ByteString ) +import Data.ByteString qualified as BS + +import Arbitrary +import Test.QuickCheck + +import Data.Either ( isRight ) +import System.OsString.Data.ByteString.Short qualified as BS8 +import System.OsString.Data.ByteString.Short.Word16 qualified as BS16 +import System.OsString.Internal.Exception.Compat +import System.OsString.Encoding.Internal.Compat +import GHC.IO (unsafePerformIO) +import GHC.IO.Encoding ( setFileSystemEncoding ) +import System.IO + ( utf16le ) +import Control.Exception +import Control.DeepSeq +import Data.Bifunctor ( first ) +import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) +import GHC.IO.Encoding.UTF16 ( mkUTF16le ) +import GHC.IO.Encoding.UTF8 ( mkUTF8 ) + + +tests :: [(String, Property)] +tests = + [ ("ucs2le_decode . ucs2le_encode == id", + property $ \(padEven -> ba) -> + let decoded = decodeWithTE ucs2le (BS8.toShort ba) + encoded = encodeWithTE ucs2le =<< decoded + in (BS8.fromShort <$> encoded) === Right ba) + , ("utf16 doesn't handle invalid surrogate pairs", + property $ + let str = [toEnum 55296, toEnum 55297] + encoded = encodeWithTE utf16le str + decoded = decodeWithTE utf16le =<< encoded +#if __GLASGOW_HASKELL__ >= 912 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) +#elif __GLASGOW_HASKELL__ >= 910 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing)) +#elif __GLASGOW_HASKELL__ >= 904 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) +#else + in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) +#endif + , ("ucs2 handles invalid surrogate pairs", + property $ + let str = [toEnum 55296, toEnum 55297] + encoded = encodeWithTE ucs2le str + decoded = decodeWithTE ucs2le =<< encoded + in decoded === Right str) + , ("can roundtrip arbitrary bytes through utf-8 (with RoundtripFailure)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 RoundtripFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 RoundtripFailure) =<< decoded + in (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs))) + + , ("can decode arbitrary strings through utf-8 (with RoundtripFailure)", + property $ + \(NonNullSurrogateString str) -> + let encoded = encodeWithTE (mkUTF8 RoundtripFailure) str + decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded + in expectFailure $ (either (const 0) length decoded, decoded) === (length str, Right str)) + + , ("utf-8 roundtrip encode cannot deal with some surrogates", + property $ + let str = [toEnum 0xDFF0, toEnum 0xDFF2] + encoded = encodeWithTE (mkUTF8 RoundtripFailure) str + decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded +#if __GLASGOW_HASKELL__ >= 912 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) +#elif __GLASGOW_HASKELL__ >= 910 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing)) +#elif __GLASGOW_HASKELL__ >= 904 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) +#else + in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) +#endif + + , ("cannot roundtrip arbitrary bytes through utf-16 (with RoundtripFailure)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le RoundtripFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le RoundtripFailure) =<< decoded + in expectFailure $ (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs))) + , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le ErrorOnCodingFailure) =<< decoded + in expectFailure $ (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf8)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 ErrorOnCodingFailure) =<< decoded + in expectFailure $ (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le TransliterateCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le TransliterateCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf8)", + property $ + \bs -> + let decoded = decodeWithTE (mkUTF8 TransliterateCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF8 TransliterateCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithBaseWindows/decodeWithBaseWindows never fails (utf16le)", + property $ + \(padEven -> bs) -> + let decoded = decodeW' (BS8.toShort bs) + encoded = encodeW' =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + , ("encodeWithBasePosix/decodeWithBasePosix never fails (utf8b)", + property $ + \bs -> ioProperty $ do + setFileSystemEncoding (mkUTF8 TransliterateCodingFailure) + let decoded = decodeP' (BS8.toShort bs) + encoded = encodeP' =<< decoded + pure $ (isRight encoded, isRight decoded) === (True, True)) + + , ("decodeWithBaseWindows == utf16le_b", + property $ + \(BS8.toShort . padEven -> bs) -> + let decoded = decodeW' bs + decoded' = first displayException $ decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) bs + in decoded === decoded') + + , ("encodeWithBaseWindows == utf16le_b", + property $ + \(NonNullSurrogateString str) -> + let decoded = encodeW' str + decoded' = first displayException $ encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) str + in decoded === decoded') + + , ("encodeWithTE/decodeWithTE never fails (utf16le_b)", + property $ + \(padEven -> bs) -> + let decoded = decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) (BS8.toShort bs) + encoded = encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) =<< decoded + in (isRight encoded, isRight decoded) === (True, True)) + ] + + +padEven :: ByteString -> ByteString +padEven bs + | even (BS.length bs) = bs + | otherwise = bs `BS.append` BS.pack [70] + + +decodeP' :: BS8.ShortByteString -> Either String String +decodeP' ba = unsafePerformIO $ do + r <- trySafe @SomeException $ decodeWithBasePosix ba + evaluate $ force $ first displayException r + +encodeP' :: String -> Either String BS8.ShortByteString +encodeP' str = unsafePerformIO $ do + r <- trySafe @SomeException $ encodeWithBasePosix str + evaluate $ force $ first displayException r + +decodeW' :: BS16.ShortByteString -> Either String String +decodeW' ba = unsafePerformIO $ do + r <- trySafe @SomeException $ decodeWithBaseWindows ba + evaluate $ force $ first displayException r + +encodeW' :: String -> Either String BS8.ShortByteString +encodeW' str = unsafePerformIO $ do + r <- trySafe @SomeException $ encodeWithBaseWindows str + evaluate $ force $ first displayException r
+ test/encoding/Spec.hs view
@@ -0,0 +1,9 @@+-- {-# LANGUAGE TypeApplications #-}++module Main (main) where++import qualified EncodingSpec as Spec+import TestUtil++main :: IO ()+main = runTests (Spec.tests)