summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArtyom <>2019-08-13 18:04:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-08-13 18:04:00 (GMT)
commit5bbb13be8f2769c6f109270aa35540efa1be153f (patch)
tree8a7f8dd6d9e3ad7ae1f0434ccc8af4ea9bcf7d38
version 1.0.01.0.0
-rw-r--r--CHANGELOG.md3
-rw-r--r--LICENSE30
-rw-r--r--src/To.hs370
-rw-r--r--to.cabal34
4 files changed, 437 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..9439b98
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+# 1.0.0
+
+Initial version.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..a25c0cd
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Aelve
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * 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.
+
+ * Neither the name of Aelve nor the names of other
+ 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
+OWNER 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/src/To.hs b/src/To.hs
new file mode 100644
index 0000000..787a0a3
--- /dev/null
+++ b/src/To.hs
@@ -0,0 +1,370 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module To
+(
+ -- * Strings and bytestrings
+ -- ** 'String'
+ ToString(..),
+ Utf8ToString(..),
+ -- ** Strict 'T.Text'
+ ToText(..),
+ Utf8ToText(..),
+ -- ** Lazy 'TL.Text'
+ ToLazyText(..),
+ Utf8ToLazyText(..),
+ -- ** Text 'TB.Builder'
+ ToTextBuilder(..),
+ Utf8ToTextBuilder(..),
+ -- ** Strict 'BS.ByteString'
+ ToByteString(..),
+ ToUtf8ByteString(..),
+ -- ** Lazy 'BSL.ByteString'
+ ToLazyByteString(..),
+ ToUtf8LazyByteString(..),
+)
+where
+
+import GHC.TypeLits (TypeError, ErrorMessage(..))
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
+import qualified Data.Text.Lazy.Builder as TB
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy.UTF8 as UTF8L
+import qualified Data.ByteString.UTF8 as UTF8
+
+----------------------------------------------------------------------------
+-- ToText
+----------------------------------------------------------------------------
+
+class ToText a where
+ -- | Transforming to strict 'T.Text'.
+ toText :: a -> T.Text
+
+-- | 'String'
+instance (a ~ Char) => ToText [a] where
+ toText = T.pack
+ {-# INLINE toText #-}
+
+instance ToText TL.Text where
+ toText = TL.toStrict
+ {-# INLINE toText #-}
+
+instance ToText TB.Builder where
+ toText = TL.toStrict . TB.toLazyText
+ {-# INLINE toText #-}
+
+-- | Use 'utf8ToText'.
+instance TypeError (SpecifyDecoding BS.ByteString "utf8ToText") =>
+ ToText BS.ByteString where
+ toText = error "unreachable"
+
+-- | Use 'utf8ToText'.
+instance TypeError (SpecifyDecoding BSL.ByteString "utf8ToText") =>
+ ToText BSL.ByteString where
+ toText = error "unreachable"
+
+----------------------------------------------------------------------------
+-- ToLazyText
+----------------------------------------------------------------------------
+
+class ToLazyText a where
+ -- | Transforming to lazy 'TL.Text'.
+ toLazyText :: a -> TL.Text
+
+-- | 'String'
+instance (a ~ Char) => ToLazyText [a] where
+ toLazyText = TL.pack
+ {-# INLINE toLazyText #-}
+
+instance ToLazyText T.Text where
+ toLazyText = TL.fromStrict
+ {-# INLINE toLazyText #-}
+
+instance ToLazyText TB.Builder where
+ toLazyText = TB.toLazyText
+ {-# INLINE toLazyText #-}
+
+-- | Use 'utf8ToLazyText'.
+instance TypeError (SpecifyDecoding BS.ByteString "utf8ToLazyText") =>
+ ToLazyText BS.ByteString where
+ toLazyText = error "unreachable"
+
+-- | Use 'utf8ToLazyText'.
+instance TypeError (SpecifyDecoding BSL.ByteString "utf8ToLazyText") =>
+ ToLazyText BSL.ByteString where
+ toLazyText = error "unreachable"
+
+----------------------------------------------------------------------------
+-- ToTextBuilder
+----------------------------------------------------------------------------
+
+class ToTextBuilder a where
+ -- | Transforming to text 'TB.Builder'.
+ toTextBuilder :: a -> TB.Builder
+
+-- | 'String'
+instance (a ~ Char) => ToTextBuilder [a] where
+ toTextBuilder = TB.fromString
+ {-# INLINE toTextBuilder #-}
+
+instance ToTextBuilder T.Text where
+ toTextBuilder = TB.fromText
+ {-# INLINE toTextBuilder #-}
+
+instance ToTextBuilder TL.Text where
+ toTextBuilder = TB.fromLazyText
+ {-# INLINE toTextBuilder #-}
+
+-- | Use 'utf8ToTextBuilder'.
+instance TypeError (SpecifyDecoding BS.ByteString "utf8ToTextBuilder") =>
+ ToTextBuilder BS.ByteString where
+ toTextBuilder = error "unreachable"
+
+-- | Use 'utf8ToTextBuilder'.
+instance TypeError (SpecifyDecoding BSL.ByteString "utf8ToTextBuilder") =>
+ ToTextBuilder BSL.ByteString where
+ toTextBuilder = error "unreachable"
+
+----------------------------------------------------------------------------
+-- ToString
+----------------------------------------------------------------------------
+
+class ToString a where
+ -- | Transforming to 'String'.
+ toString :: a -> String
+
+instance ToString T.Text where
+ toString = T.unpack
+ {-# INLINE toString #-}
+
+instance ToString TL.Text where
+ toString = TL.unpack
+ {-# INLINE toString #-}
+
+instance ToString TB.Builder where
+ toString = TL.unpack . TB.toLazyText
+ {-# INLINE toString #-}
+
+-- | Use 'utf8ToString'.
+instance TypeError (SpecifyDecoding BS.ByteString "utf8ToString") =>
+ ToString BS.ByteString where
+ toString = error "unreachable"
+
+-- | Use 'utf8ToString'.
+instance TypeError (SpecifyDecoding BSL.ByteString "utf8ToString") =>
+ ToString BSL.ByteString where
+ toString = error "unreachable"
+
+----------------------------------------------------------------------------
+-- ToByteString
+----------------------------------------------------------------------------
+
+class ToByteString a where
+ -- | Transforming to strict 'BS.ByteString'.
+ toByteString :: a -> BS.ByteString
+
+-- | Use 'toUtf8ByteString'.
+instance TypeError (SpecifyEncoding T.Text "toUtf8ByteString") =>
+ ToByteString T.Text where
+ toByteString = error "unreachable"
+
+-- | Use 'toUtf8ByteString'.
+instance TypeError (SpecifyEncoding TL.Text "toUtf8ByteString") =>
+ ToByteString TL.Text where
+ toByteString = error "unreachable"
+
+-- | Use 'toUtf8ByteString'.
+instance TypeError (SpecifyEncoding TB.Builder "toUtf8ByteString") =>
+ ToByteString TB.Builder where
+ toByteString = error "unreachable"
+
+-- | Use 'toUtf8ByteString'.
+instance (a ~ Char, TypeError (SpecifyEncoding String "toUtf8ByteString")) =>
+ ToByteString [a] where
+ toByteString = error "unreachable"
+
+-- | Use 'toUtf8ByteString'.
+instance ToByteString BSL.ByteString where
+ toByteString = BSL.toStrict
+ {-# INLINE toByteString #-}
+
+----------------------------------------------------------------------------
+-- ToLazyByteString
+----------------------------------------------------------------------------
+
+class ToLazyByteString a where
+ -- | Transforming to lazy 'BSL.ByteString'.
+ toLazyByteString :: a -> BSL.ByteString
+
+-- | Use 'toUtf8LazyByteString'.
+instance TypeError (SpecifyEncoding T.Text "toUtf8LazyByteString") =>
+ ToLazyByteString T.Text where
+ toLazyByteString = error "unreachable"
+
+-- | Use 'toUtf8LazyByteString'.
+instance TypeError (SpecifyEncoding TL.Text "toUtf8LazyByteString") =>
+ ToLazyByteString TL.Text where
+ toLazyByteString = error "unreachable"
+
+-- | Use 'toUtf8LazyByteString'.
+instance TypeError (SpecifyEncoding TB.Builder "toUtf8LazyByteString") =>
+ ToLazyByteString TB.Builder where
+ toLazyByteString = error "unreachable"
+
+-- | Use 'toUtf8LazyByteString'.
+instance (a ~ Char, TypeError (SpecifyEncoding String "toUtf8LazyByteString")) =>
+ ToLazyByteString [a] where
+ toLazyByteString = error "unreachable"
+
+instance ToLazyByteString BS.ByteString where
+ toLazyByteString = BSL.fromStrict
+ {-# INLINE toLazyByteString #-}
+
+----------------------------------------------------------------------------
+-- Utf8ToString
+----------------------------------------------------------------------------
+
+class Utf8ToString a where
+ -- | Decode UTF8-encoded text to a 'String'.
+ --
+ -- Malformed characters are replaced by @U+FFFD@ (the Unicode
+ -- replacement character).
+ utf8ToString :: a -> String
+
+instance Utf8ToString BS.ByteString where
+ utf8ToString = UTF8.toString
+ {-# INLINE utf8ToString #-}
+
+instance Utf8ToString BSL.ByteString where
+ utf8ToString = UTF8L.toString
+ {-# INLINE utf8ToString #-}
+
+----------------------------------------------------------------------------
+-- Utf8ToText
+----------------------------------------------------------------------------
+
+class Utf8ToText a where
+ -- | Decode UTF8-encoded text to a strict 'T.Text'.
+ --
+ -- Malformed characters are replaced by @U+FFFD@ (the Unicode
+ -- replacement character).
+ utf8ToText :: a -> T.Text
+
+instance Utf8ToText BS.ByteString where
+ utf8ToText = T.decodeUtf8With T.lenientDecode
+ {-# INLINE utf8ToText #-}
+
+instance Utf8ToText BSL.ByteString where
+ utf8ToText = T.decodeUtf8With T.lenientDecode . BSL.toStrict
+ {-# INLINE utf8ToText #-}
+
+----------------------------------------------------------------------------
+-- Utf8ToLazyText
+----------------------------------------------------------------------------
+
+class Utf8ToLazyText a where
+ -- | Decode UTF8-encoded text to a lazy 'TL.Text'.
+ --
+ -- Malformed characters are replaced by @U+FFFD@ (the Unicode
+ -- replacement character).
+ utf8ToLazyText :: a -> TL.Text
+
+instance Utf8ToLazyText BS.ByteString where
+ utf8ToLazyText = TL.fromStrict . T.decodeUtf8With T.lenientDecode
+ {-# INLINE utf8ToLazyText #-}
+
+instance Utf8ToLazyText BSL.ByteString where
+ utf8ToLazyText = TL.decodeUtf8With T.lenientDecode
+ {-# INLINE utf8ToLazyText #-}
+
+----------------------------------------------------------------------------
+-- Utf8ToLazyText
+----------------------------------------------------------------------------
+
+class Utf8ToTextBuilder a where
+ -- | Decode UTF8-encoded text to a text 'TB.Builder'.
+ --
+ -- Malformed characters are replaced by @U+FFFD@ (the Unicode
+ -- replacement character).
+ utf8ToTextBuilder :: a -> TB.Builder
+
+instance Utf8ToTextBuilder BS.ByteString where
+ utf8ToTextBuilder = TB.fromText . T.decodeUtf8With T.lenientDecode
+ {-# INLINE utf8ToTextBuilder #-}
+
+instance Utf8ToTextBuilder BSL.ByteString where
+ utf8ToTextBuilder = TB.fromLazyText . TL.decodeUtf8With T.lenientDecode
+ {-# INLINE utf8ToTextBuilder #-}
+
+----------------------------------------------------------------------------
+-- ToUtf8ByteString
+----------------------------------------------------------------------------
+
+class ToUtf8ByteString a where
+ -- | UTF8-encode text to a 'BS.ByteString'.
+ toUtf8ByteString :: a -> BS.ByteString
+
+instance ToUtf8ByteString T.Text where
+ toUtf8ByteString = T.encodeUtf8
+ {-# INLINE toUtf8ByteString #-}
+
+instance ToUtf8ByteString TL.Text where
+ toUtf8ByteString = T.encodeUtf8 . TL.toStrict
+ {-# INLINE toUtf8ByteString #-}
+
+instance ToUtf8ByteString TB.Builder where
+ toUtf8ByteString = T.encodeUtf8 . TL.toStrict . TB.toLazyText
+ {-# INLINE toUtf8ByteString #-}
+
+-- | 'String'
+instance (a ~ Char) => ToUtf8ByteString [a] where
+ toUtf8ByteString = UTF8.fromString
+ {-# INLINE toUtf8ByteString #-}
+
+----------------------------------------------------------------------------
+-- ToUtf8LazyByteString
+----------------------------------------------------------------------------
+
+class ToUtf8LazyByteString a where
+ -- | UTF8-encode text to a lazy 'BSL.ByteString'.
+ toUtf8LazyByteString :: a -> BSL.ByteString
+
+instance ToUtf8LazyByteString T.Text where
+ toUtf8LazyByteString = TL.encodeUtf8 . TL.fromStrict
+ {-# INLINE toUtf8LazyByteString #-}
+
+instance ToUtf8LazyByteString TL.Text where
+ toUtf8LazyByteString = TL.encodeUtf8
+ {-# INLINE toUtf8LazyByteString #-}
+
+instance ToUtf8LazyByteString TB.Builder where
+ toUtf8LazyByteString = TL.encodeUtf8 . TB.toLazyText
+ {-# INLINE toUtf8LazyByteString #-}
+
+-- | 'String'
+instance (a ~ Char) => ToUtf8LazyByteString [a] where
+ toUtf8LazyByteString = UTF8L.fromString
+ {-# INLINE toUtf8LazyByteString #-}
+
+----------------------------------------------------------------------------
+-- Type errors
+----------------------------------------------------------------------------
+
+type SpecifyEncoding type_ proposed =
+ 'Text "Can not encode a " :<>: 'ShowType type_ :<>:
+ 'Text " without specifying encoding." :$$:
+ 'Text "Use '" :<>: 'Text proposed :<>:
+ 'Text "' if you want to encode as UTF8."
+
+type SpecifyDecoding type_ proposed =
+ 'Text "Can not decode a " :<>: 'ShowType type_ :<>:
+ 'Text " without specifying encoding." :$$:
+ 'Text "Use '" :<>: 'Text proposed :<>:
+ 'Text "' if you want to decode ASCII or UTF8."
diff --git a/to.cabal b/to.cabal
new file mode 100644
index 0000000..23faa0c
--- /dev/null
+++ b/to.cabal
@@ -0,0 +1,34 @@
+name: to
+version: 1.0.0
+synopsis: Simple, safe, boring type conversions
+description:
+ `to` contains type conversions for popular Haskell types. All provided
+ conversions are safe and boring.
+
+license: BSD3
+license-file: LICENSE
+author: Artyom Kazak
+maintainer: Artyom Kazak <artyom@aelve.com>
+homepage: https://github.com/aelve/to
+bug-reports: https://github.com/aelve/to/issues
+category: Control
+build-type: Simple
+extra-source-files: CHANGELOG.md
+tested-with: GHC ==8.0.2, GHC ==8.2.2, GHC ==8.4.4, GHC ==8.6.4
+cabal-version: >=1.10
+
+source-repository head
+ type: git
+ location: git@github.com:aelve/to.git
+
+library
+ exposed-modules: To
+ build-depends:
+ base >=4.9 && <5,
+ text,
+ bytestring,
+ utf8-string
+ hs-source-dirs: src
+ default-language: Haskell2010
+ ghc-options: -Wall
+ -Wno-unticked-promoted-constructors