diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,140 @@ +# os-string-compat + +[![GitHub Actions status](https://github.com/Anteproperispomenon/os-string-compat/actions/workflows/haskell.yml/badge.svg)](https://github.com/Anteproperispomenon/os-string-compat/actions/workflows/haskell.yml) +[![GitHub Actions status](https://github.com/Anteproperispomenon/os-string-compat/actions/workflows/haskell_cabal.yml/badge.svg)](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 + 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 `.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`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -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 + ] diff --git a/bench/BenchOsString.hs b/bench/BenchOsString.hs new file mode 100644 --- /dev/null +++ b/bench/BenchOsString.hs @@ -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 diff --git a/bench/BenchPosixString.hs b/bench/BenchPosixString.hs new file mode 100644 --- /dev/null +++ b/bench/BenchPosixString.hs @@ -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 diff --git a/bench/BenchWindowsString.hs b/bench/BenchWindowsString.hs new file mode 100644 --- /dev/null +++ b/bench/BenchWindowsString.hs @@ -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 diff --git a/os-string-compat.cabal b/os-string-compat.cabal new file mode 100644 --- /dev/null +++ b/os-string-compat.cabal @@ -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 +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 diff --git a/src/System/OsString/Compat.hs b/src/System/OsString/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Compat.hs @@ -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 + diff --git a/src/System/OsString/Encoding/Compat.hs b/src/System/OsString/Encoding/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Encoding/Compat.hs @@ -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 + diff --git a/src/System/OsString/Encoding/Internal/Compat.hs b/src/System/OsString/Encoding/Internal/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Encoding/Internal/Compat.hs @@ -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 diff --git a/src/System/OsString/Internal/Compat.hs b/src/System/OsString/Internal/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Internal/Compat.hs @@ -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 + diff --git a/src/System/OsString/Internal/Exception/Compat.hs b/src/System/OsString/Internal/Exception/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Internal/Exception/Compat.hs @@ -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 diff --git a/src/System/OsString/Internal/Types/Compat.hs b/src/System/OsString/Internal/Types/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Internal/Types/Compat.hs @@ -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 diff --git a/src/System/OsString/Posix/Compat.hs b/src/System/OsString/Posix/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Posix/Compat.hs @@ -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" diff --git a/src/System/OsString/Windows/Compat.hs b/src/System/OsString/Windows/Compat.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/Windows/Compat.hs @@ -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 diff --git a/src/System/OsString/include/Common.hs b/src/System/OsString/include/Common.hs new file mode 100644 --- /dev/null +++ b/src/System/OsString/include/Common.hs @@ -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 diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Arbitrary.hs @@ -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 diff --git a/test/TestUtil.hs b/test/TestUtil.hs new file mode 100644 --- /dev/null +++ b/test/TestUtil.hs @@ -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" diff --git a/test/bytestring/Properties/OsString.hs b/test/bytestring/Properties/OsString.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/OsString.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#undef WORD16 +#undef POSIX +#undef WIN +#define OSWORD +#include "include/Common.hs" diff --git a/test/bytestring/Properties/PosixString.hs b/test/bytestring/Properties/PosixString.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/PosixString.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#undef WORD16 +#define POSIX +#undef WIN +#undef OSWORD +#include "include/Common.hs" diff --git a/test/bytestring/Properties/ShortByteString.hs b/test/bytestring/Properties/ShortByteString.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/ShortByteString.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#undef WORD16 +#undef WIN +#undef POSIX +#undef OSWORD +#include "include/Common.hs" diff --git a/test/bytestring/Properties/ShortByteString/Word16.hs b/test/bytestring/Properties/ShortByteString/Word16.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/ShortByteString/Word16.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#define WORD16 +#undef WIN +#undef POSIX +#undef OSWORD +#include "../include/Common.hs" diff --git a/test/bytestring/Properties/WindowsString.hs b/test/bytestring/Properties/WindowsString.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/WindowsString.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +#define WORD16 +#define WIN +#undef POSIX +#undef OSWORD +#include "include/Common.hs" diff --git a/test/bytestring/Properties/include/Common.hs b/test/bytestring/Properties/include/Common.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Properties/include/Common.hs @@ -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 diff --git a/test/bytestring/Spec.hs b/test/bytestring/Spec.hs new file mode 100644 --- /dev/null +++ b/test/bytestring/Spec.hs @@ -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) diff --git a/test/encoding/EncodingSpec.hs b/test/encoding/EncodingSpec.hs new file mode 100644 --- /dev/null +++ b/test/encoding/EncodingSpec.hs @@ -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 diff --git a/test/encoding/Spec.hs b/test/encoding/Spec.hs new file mode 100644 --- /dev/null +++ b/test/encoding/Spec.hs @@ -0,0 +1,9 @@ +-- {-# LANGUAGE TypeApplications #-} + +module Main (main) where + +import qualified EncodingSpec as Spec +import TestUtil + +main :: IO () +main = runTests (Spec.tests)