diff --git a/isomorphism-class.cabal b/isomorphism-class.cabal --- a/isomorphism-class.cabal +++ b/isomorphism-class.cabal @@ -1,65 +1,120 @@ cabal-version: 3.0 -name: isomorphism-class -version: 0.1.1 -synopsis: Isomorphism typeclass solving the conversion problem -description: Lawful typeclass for lossless conversion between types. -category: Conversion -homepage: https://github.com/nikita-volkov/isomorphism-class -bug-reports: https://github.com/nikita-volkov/isomorphism-class/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2022 Nikita Volkov -license: MIT -license-file: LICENSE +name: isomorphism-class +version: 0.2 +synopsis: Isomorphism typeclass solving the conversion problem +description: Lawful typeclass for lossless conversion between types. +category: Conversion +homepage: https://github.com/nikita-volkov/isomorphism-class +bug-reports: https://github.com/nikita-volkov/isomorphism-class/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2022 Nikita Volkov +license: MIT +license-file: LICENSE source-repository head - type: git + type: git location: git://github.com/nikita-volkov/isomorphism-class.git common language-settings - default-language: Haskell2010 + default-language: Haskell2010 default-extensions: - NoImplicitPrelude + BlockArguments + DefaultSignatures FlexibleContexts FlexibleInstances MagicHash MultiParamTypeClasses + NoImplicitPrelude ScopedTypeVariables TypeApplications UndecidableSuperClasses library - import: language-settings - hs-source-dirs: library + import: language-settings + hs-source-dirs: library exposed-modules: IsomorphismClass other-modules: + IsomorphismClass.Classes + IsomorphismClass.Classes.Is + IsomorphismClass.Classes.IsSome + IsomorphismClass.Laws + IsomorphismClass.Optics IsomorphismClass.Prelude + IsomorphismClass.Proxies + IsomorphismClass.Proxies.ViaIsSome + IsomorphismClass.Relations + IsomorphismClass.Relations.BoxedVectorAndList + IsomorphismClass.Relations.BoxedVectorAndSeq + IsomorphismClass.Relations.ByteArrayAndByteString + IsomorphismClass.Relations.ByteArrayAndLazyByteString + IsomorphismClass.Relations.ByteArrayAndLazyByteStringBuilder + IsomorphismClass.Relations.ByteArrayAndShortByteString + IsomorphismClass.Relations.ByteArrayAndTextArray + IsomorphismClass.Relations.ByteArrayAndWord8List + IsomorphismClass.Relations.ByteStringAndLazyByteString + IsomorphismClass.Relations.ByteStringAndLazyByteStringBuilder + IsomorphismClass.Relations.ByteStringAndShortByteString + IsomorphismClass.Relations.ByteStringAndText + IsomorphismClass.Relations.ByteStringAndTextArray + IsomorphismClass.Relations.ByteStringAndWord8List + IsomorphismClass.Relations.Int16AndWord16 + IsomorphismClass.Relations.Int32AndWord32 + IsomorphismClass.Relations.Int64AndWord64 + IsomorphismClass.Relations.Int8AndWord8 + IsomorphismClass.Relations.IntAndWord + IsomorphismClass.Relations.IntMapAndMapOfInt + IsomorphismClass.Relations.IntSetAndSetOfInts + IsomorphismClass.Relations.LazyByteStringAndLazyByteStringBuilder + IsomorphismClass.Relations.LazyByteStringAndLazyText + IsomorphismClass.Relations.LazyByteStringAndShortByteString + IsomorphismClass.Relations.LazyByteStringAndTextArray + IsomorphismClass.Relations.LazyByteStringAndWord8List + IsomorphismClass.Relations.LazyByteStringBuilderAndShortByteString + IsomorphismClass.Relations.LazyByteStringBuilderAndTextArray + IsomorphismClass.Relations.LazyByteStringBuilderAndWord8List + IsomorphismClass.Relations.LazyTextAndLazyTextBuilder + IsomorphismClass.Relations.LazyTextAndStrictTextBuilder + IsomorphismClass.Relations.LazyTextAndString + IsomorphismClass.Relations.LazyTextAndText + IsomorphismClass.Relations.LazyTextBuilderAndStrictTextBuilder + IsomorphismClass.Relations.LazyTextBuilderAndString + IsomorphismClass.Relations.LazyTextBuilderAndText + IsomorphismClass.Relations.ListAndSeq + IsomorphismClass.Relations.ShortByteStringAndTextArray + IsomorphismClass.Relations.ShortByteStringAndWord8List + IsomorphismClass.Relations.StrictTextBuilderAndString + IsomorphismClass.Relations.StrictTextBuilderAndText + IsomorphismClass.Relations.StringAndText + IsomorphismClass.Relations.TextArrayAndWord8List IsomorphismClass.TextCompat.Array + build-tool-depends: autoexporter:autoexporter >=1.1.19 && <3 build-depends: - , base >=4.12 && <5 - , bytestring >=0.10 && <0.13 - , containers >=0.6 && <0.8 - , hashable >=1 && <2 - , primitive >=0.7.3 && <0.10 - , text >=1.2 && <2.2 - , unordered-containers >=0.2 && <0.3 - , vector >=0.12 && <0.14 + QuickCheck >=2.13 && <3, + base >=4.12 && <5, + bytestring >=0.10 && <0.13, + containers >=0.6 && <0.8, + hashable >=1 && <2, + primitive >=0.7.3 && <0.10, + profunctors >=5 && <6, + text >=1.2 && <2.2, + unordered-containers >=0.2 && <0.3, + vector >=0.12 && <0.14, test-suite test - import: language-settings - type: exitcode-stdio-1.0 + import: language-settings + type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Main.hs - other-modules: Test.ExtraInstances + main-is: Main.hs + other-modules: Test.ExtraInstances build-depends: - , bytestring >=0.11.1.0 && <0.13 - , isomorphism-class - , primitive >=0.7.3 && <0.10 - , QuickCheck >=2.13 && <3 - , quickcheck-instances >=0.3.28 && <0.4 - , rebase >=1.15 && <2 - , tasty >=1.2.3 && <2 - , tasty-quickcheck >=0.10.1 && <0.11 - , text >=1.2 && <3 - , vector >=0.12 && <0.14 + QuickCheck >=2.13 && <3, + bytestring >=0.11.1.0 && <0.13, + isomorphism-class, + primitive >=0.7.3 && <0.10, + quickcheck-instances >=0.3.32 && <0.4, + rebase >=1.15 && <2, + tasty >=1.2.3 && <2, + tasty-quickcheck >=0.10.1 && <0.11, + text >=1.2 && <3, diff --git a/library/IsomorphismClass.hs b/library/IsomorphismClass.hs --- a/library/IsomorphismClass.hs +++ b/library/IsomorphismClass.hs @@ -1,14 +1,12 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} -- | --- Isomorphism as a lawful solution to the conversion problem. +-- Lawful solution to the conversion problem. -- -- = Conversion problem -- -- Have you ever looked for a @toString@ function? How often do you -- import @Data.Text.Lazy@ only to call its 'Data.Text.Lazy.fromStrict'? How --- about importing @Data.Text@ only to call its 'Data.Text.unpack'? How -- about going thru the always fun sequence of -- importing @Data.ByteString.Builder@ only to call its -- 'Data.ByteString.Builder.toLazyByteString' and then importing @@ -22,28 +20,30 @@ -- -- = Why another conversion library? -- --- Many libraries exist that approach the conversion problem. However all of +-- Many libraries exist that approach the conversion problem. However most of -- them provide lawless typeclasses leaving it up to the author of the -- instance to define what makes a proper conversion. This results in --- inconsistencies across instances and their behaviour being not evident to --- the user. +-- inconsistencies across instances, their behaviour not being evident to +-- the user and no way to check whether an instance is correct. -- -- This library tackles this problem with a lawful typeclass, making it --- evident what any of its instances do. +-- evident what any of its instances do and it provides property-tests for you +-- to validate your instances. -- --- = The law +-- = The insight -- -- The key insight of this library is that if you add a requirement for the -- conversion to be lossless and to have a mirror conversion in the opposite -- direction, there usually appears to be only one way of defining it. That -- makes it very clear what the conversion does to the user and how to define -- it to the author of the conversion. +-- It also gives a clear criteria for validating whether the instances are correct, which can be encoded in property-tests. -- -- That insight itself stems from an observation that almost all of the -- practical conversions in Haskell share a property: you can restore the --- original data from its converted form. E.g., you can get a bytestring from --- a builder and you can create a builder from a bytestring, you can convert --- a text into a list of chars and vice-versa, bytestring to\/from bytearray, +-- original data from its converted form. E.g., you can get a text from +-- a text-builder and you can create a text-builder from a text, you can convert +-- a bytestring into a list of bytes and vice-versa, bytestring to\/from bytearray, -- strict bytestring to\/from lazy, list to\/from sequence, sequence to/from -- vector, set of ints to\/from int-set. In other words, it's always a two-way -- street with them and there's a lot of instances of this pattern. @@ -52,16 +52,24 @@ -- -- A few other accidental findings like encoding this property with recursive -- typeclass constraints and fine-tuning for the use of --- the @TypeApplications@ extension resulted in a very terse yet clear API. +-- the @TypeApplications@ extension resulted in a terse and clear API. -- -- Essentially the whole API is just two functions: 'to' and 'from'. Both -- perform a conversion between two types. The only difference between them -- is in what the first type application parameter specifies. E.g.: -- --- > fromString = from @String +-- > toString = to @String -- --- > toText = to @Text +-- > fromText = from @Text -- +-- The types are self-evident: +-- +-- > > :t to @String +-- > to @String :: Is String b => b -> String +-- +-- > > :t from @Text +-- > from @Text :: Is Text b => Text -> b +-- -- In other words 'to' and 'from' let you explicitly specify either the source -- or the target type of a conversion when you need to help the type -- inferencer. @@ -71,564 +79,51 @@ -- @ -- renderNameAndHeight :: 'Text' -> 'Int' -> 'Text' -- renderNameAndHeight name height = --- 'from' @'TextLazyBuilder.Builder' $ --- "Height of " <> 'to' name <> " is " <> 'showAs' height +-- 'from' @'Data.Text.Encoding.StrictTextBuilder' $ +-- "Height of " <> 'to' name <> " is " <> 'to' (show height) -- @ -- -- @ --- combineEncodings :: 'ByteStringShort.ShortByteString' -> 'PrimitiveByteArray.ByteArray' -> 'ByteString' -> [Word8] +-- combineEncodings :: 'Data.ByteString.Short.ShortByteString' -> 'Data.Primitive.ByteArray' -> 'Data.ByteString.Lazy.ByteString' -> [Word8] -- combineEncodings a b c = --- 'from' @'ByteStringBuilder.Builder' $ +-- 'from' @'Data.ByteString.Builder.Builder' $ -- 'to' a <> 'to' b <> 'to' c -- @ -module IsomorphismClass - ( -- * Typeclass - IsomorphicTo (..), - from, - - -- * Common Utilities - showAs, - - -- * FAQ - - -- | - -- = Why no instance for Text/ByteString? - -- - -- It is not a total isomorphism. Yes, you can represent every Text value using ByteString. - -- However, not every ByteString can be decoded as valid Text. - -- It doesn't matter which encoding you apply: UTF8, ISO-8859 or any other. - -- - -- = String/Text is not exactly a valid isomorphism - -- - -- Yes. It does not make a valid isomorphism. It is an exception, - -- due to the ubiquity of String-oriented APIs. - -- - -- = Are Int64/Word64 really isomorphic? - -- - -- Yes. Negative integer values get mapped to the upper value range of Word64. - -- Mapping between those types happens in bits using the 'fromIntegral' function. - ) -where - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Builder as ByteStringBuilder -import qualified Data.ByteString.Lazy as ByteStringLazy -import qualified Data.ByteString.Short as ByteStringShort -import qualified Data.ByteString.Short.Internal as ByteStringShortInternal -import qualified Data.Primitive.ByteArray as PrimitiveByteArray -import qualified Data.Sequence as Seq -import qualified Data.Text as Text -import qualified Data.Text.Lazy as TextLazy -import qualified Data.Text.Lazy.Builder as TextLazyBuilder -import qualified Data.Vector as Vector -import IsomorphismClass.Prelude -#if !MIN_VERSION_text(2,1,0) -import qualified Data.Text.Array as TextArray -import qualified IsomorphismClass.TextCompat.Array as TextCompatArray -#endif -#if MIN_VERSION_text(2,0,2) -import qualified Data.Text.Encoding as TextEncoding -#endif - --- | Bidirectional conversion between two types with no loss of information. --- The bidirectionality is encoded via a recursive dependency with arguments --- flipped. -- --- You can read the signature @IsomorphicTo a b@ as \"/B/ is isomorphic to /A/\". --- --- __Laws__ --- --- /B/ is isomorphic to /A/ if and only if there exists a conversion from /B/ --- to /A/ ('to') and a conversion from /A/ to /B/ ('from') such that: --- --- - @'from' . 'to' = 'id'@ - For all values of /B/ converting from /B/ to /A/ --- and then converting from /A/ to /B/ produces a value that is identical --- to the original. --- --- - @'to' . 'from' = 'id'@ - For all values of /A/ converting from /A/ to /B/ --- and then converting from /B/ to /A/ produces a value that is identical --- to the original. --- --- __Usage__ --- --- This class is particularly easy to use in combination with --- the @TypeApplications@ extension making it clear to the reader what sort --- of conversion he sees. E.g., --- --- > fromString = from @String --- --- > toText = to @Text --- --- The types are also self-evident: --- --- > > :t from @String --- > from @String :: IsomorphicTo b String => String -> b --- --- > > :t to @Text --- > to @Text :: IsomorphicTo Text b => b -> Text --- --- __Instance Definition__ --- --- For each pair of isomorphic types (/A/ and /B/) the compiler will require --- you to define two instances, namely: @IsomorphicTo A B@ and @IsomorphicTo --- B A@. -class (IsomorphicTo b a) => IsomorphicTo a b where - to :: b -> a - --- - -instance IsomorphicTo String Text where - to = Text.unpack - -instance IsomorphicTo String TextLazy.Text where - to = TextLazy.unpack - -instance IsomorphicTo String TextLazyBuilder.Builder where - to = TextLazy.unpack . TextLazyBuilder.toLazyText - -#if MIN_VERSION_text(2,0,2) -instance IsomorphicTo String TextEncoding.StrictBuilder where - to = to . TextEncoding.strictBuilderToText -#endif - --- - -instance IsomorphicTo [Word8] ByteString where - to = ByteString.unpack - -instance IsomorphicTo [Word8] ByteStringLazy.ByteString where - to = ByteStringLazy.unpack - -instance IsomorphicTo [Word8] ByteStringShort.ShortByteString where - to = ByteStringShort.unpack - -instance IsomorphicTo [Word8] ByteStringBuilder.Builder where - to = ByteStringLazy.unpack . ByteStringBuilder.toLazyByteString - -instance IsomorphicTo [Word8] PrimitiveByteArray.ByteArray where - to = toList - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo [Word8] TextArray.Array where - to = to . to @ByteStringShort.ShortByteString -#endif - --- - -instance IsomorphicTo [a] [a] where - to = id - -instance IsomorphicTo [a] (Vector a) where - to = toList - -instance IsomorphicTo [a] (Seq a) where - to = toList - --- - -instance IsomorphicTo Text Text where - to = id - --- | Performs replacement on invalid Unicode chars in the string. -instance IsomorphicTo Text String where - to = Text.pack - -instance IsomorphicTo Text TextLazy.Text where - to = TextLazy.toStrict - -instance IsomorphicTo Text TextLazyBuilder.Builder where - to = TextLazy.toStrict . TextLazyBuilder.toLazyText - -#if MIN_VERSION_text(2,0,2) -instance IsomorphicTo Text TextEncoding.StrictBuilder where - to = TextEncoding.strictBuilderToText -#endif - --- - -instance IsomorphicTo TextLazy.Text TextLazy.Text where - to = id - --- | Performs replacement on invalid Unicode chars in the string. -instance IsomorphicTo TextLazy.Text String where - to = TextLazy.pack - -instance IsomorphicTo TextLazy.Text Text where - to = TextLazy.fromStrict - -instance IsomorphicTo TextLazy.Text TextLazyBuilder.Builder where - to = TextLazyBuilder.toLazyText - -#if MIN_VERSION_text(2,0,2) -instance IsomorphicTo TextLazy.Text TextEncoding.StrictBuilder where - to = to . TextEncoding.strictBuilderToText -#endif - --- - -instance IsomorphicTo TextLazyBuilder.Builder TextLazyBuilder.Builder where - to = id - --- | Performs replacement on invalid Unicode chars in the string. -instance IsomorphicTo TextLazyBuilder.Builder String where - to = TextLazyBuilder.fromString - -instance IsomorphicTo TextLazyBuilder.Builder Text where - to = TextLazyBuilder.fromText - -instance IsomorphicTo TextLazyBuilder.Builder TextLazy.Text where - to = TextLazyBuilder.fromLazyText - -#if MIN_VERSION_text(2,0,2) -instance IsomorphicTo TextLazyBuilder.Builder TextEncoding.StrictBuilder where - to = to . TextEncoding.strictBuilderToText -#endif - -#if MIN_VERSION_text(2,0,2) --- - -instance IsomorphicTo TextEncoding.StrictBuilder TextEncoding.StrictBuilder where - to = id - --- | Performs replacement on invalid Unicode chars in the string. -instance IsomorphicTo TextEncoding.StrictBuilder String where - to = TextEncoding.textToStrictBuilder . to - -instance IsomorphicTo TextEncoding.StrictBuilder Text where - to = TextEncoding.textToStrictBuilder - -instance IsomorphicTo TextEncoding.StrictBuilder TextLazy.Text where - to = TextEncoding.textToStrictBuilder . to - -instance IsomorphicTo TextEncoding.StrictBuilder TextLazyBuilder.Builder where - to = TextEncoding.textToStrictBuilder . to - -#endif --- - -instance IsomorphicTo ByteString ByteString where - to = id - -instance IsomorphicTo ByteString [Word8] where - to = ByteString.pack - -instance IsomorphicTo ByteString ByteStringLazy.ByteString where - to = ByteStringLazy.toStrict - -instance IsomorphicTo ByteString ByteStringShort.ShortByteString where - to = ByteStringShort.fromShort - -instance IsomorphicTo ByteString ByteStringBuilder.Builder where - to = ByteStringLazy.toStrict . ByteStringBuilder.toLazyByteString - -instance IsomorphicTo ByteString PrimitiveByteArray.ByteArray where - to = to . to @ByteStringShort.ShortByteString - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo ByteString TextArray.Array where - to = to . to @ByteStringShort.ShortByteString -#endif - --- - -instance IsomorphicTo ByteStringLazy.ByteString ByteStringLazy.ByteString where - to = id - -instance IsomorphicTo ByteStringLazy.ByteString [Word8] where - to = ByteStringLazy.pack - -instance IsomorphicTo ByteStringLazy.ByteString ByteString where - to = ByteStringLazy.fromStrict - -instance IsomorphicTo ByteStringLazy.ByteString ByteStringShort.ShortByteString where - to = from @ByteString . to - -instance IsomorphicTo ByteStringLazy.ByteString ByteStringBuilder.Builder where - to = ByteStringBuilder.toLazyByteString - -instance IsomorphicTo ByteStringLazy.ByteString PrimitiveByteArray.ByteArray where - to = to . to @ByteStringShort.ShortByteString - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo ByteStringLazy.ByteString TextArray.Array where - to = to . to @ByteStringShort.ShortByteString -#endif - --- - -instance IsomorphicTo ByteStringShort.ShortByteString ByteStringShort.ShortByteString where - to = id - -instance IsomorphicTo ByteStringShort.ShortByteString [Word8] where - to = ByteStringShort.pack - -instance IsomorphicTo ByteStringShort.ShortByteString ByteString where - to = ByteStringShort.toShort - -instance IsomorphicTo ByteStringShort.ShortByteString ByteStringLazy.ByteString where - to = to . to @ByteString - -instance IsomorphicTo ByteStringShort.ShortByteString ByteStringBuilder.Builder where - to = to . to @ByteStringLazy.ByteString - -instance IsomorphicTo ByteStringShort.ShortByteString PrimitiveByteArray.ByteArray where - to (PrimitiveByteArray.ByteArray array) = ByteStringShortInternal.SBS array - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo ByteStringShort.ShortByteString TextArray.Array where - to a = ByteStringShortInternal.SBS (TextCompatArray.toUnliftedByteArray a) -#endif - --- - -instance IsomorphicTo ByteStringBuilder.Builder ByteStringBuilder.Builder where - to = id - -instance IsomorphicTo ByteStringBuilder.Builder [Word8] where - to = to . to @ByteString - -instance IsomorphicTo ByteStringBuilder.Builder ByteString where - to = ByteStringBuilder.byteString - -instance IsomorphicTo ByteStringBuilder.Builder ByteStringLazy.ByteString where - to = ByteStringBuilder.lazyByteString - -instance IsomorphicTo ByteStringBuilder.Builder ByteStringShort.ShortByteString where - to = ByteStringBuilder.shortByteString - -instance IsomorphicTo ByteStringBuilder.Builder PrimitiveByteArray.ByteArray where - to = to . to @ByteStringShort.ShortByteString - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo ByteStringBuilder.Builder TextArray.Array where - to = to . to @ByteStringShort.ShortByteString -#endif - --- - -instance IsomorphicTo PrimitiveByteArray.ByteArray PrimitiveByteArray.ByteArray where - to = id - -instance IsomorphicTo PrimitiveByteArray.ByteArray [Word8] where - to = fromList - -instance IsomorphicTo PrimitiveByteArray.ByteArray ByteStringShort.ShortByteString where - to (ByteStringShortInternal.SBS array) = PrimitiveByteArray.ByteArray array - -instance IsomorphicTo PrimitiveByteArray.ByteArray ByteString where - to = to . to @ByteStringShort.ShortByteString - -instance IsomorphicTo PrimitiveByteArray.ByteArray ByteStringLazy.ByteString where - to = to . to @ByteStringShort.ShortByteString - -instance IsomorphicTo PrimitiveByteArray.ByteArray ByteStringBuilder.Builder where - to = to . to @ByteStringShort.ShortByteString - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo PrimitiveByteArray.ByteArray TextArray.Array where - to a = PrimitiveByteArray.ByteArray (TextCompatArray.toUnliftedByteArray a) -#endif - --- - -#if !MIN_VERSION_text(2,1,0) -instance IsomorphicTo TextArray.Array [Word8] where - to = to . to @ByteStringShort.ShortByteString - -instance IsomorphicTo TextArray.Array PrimitiveByteArray.ByteArray where - to (PrimitiveByteArray.ByteArray arr) = TextCompatArray.fromUnliftedByteArray arr - -instance IsomorphicTo TextArray.Array ByteStringShort.ShortByteString where - to (ByteStringShortInternal.SBS arr) = TextCompatArray.fromUnliftedByteArray arr - -instance IsomorphicTo TextArray.Array ByteString where - to = to . to @ByteStringShort.ShortByteString - -instance IsomorphicTo TextArray.Array ByteStringLazy.ByteString where - to = to . to @ByteStringShort.ShortByteString - -instance IsomorphicTo TextArray.Array ByteStringBuilder.Builder where - to = to . to @ByteStringShort.ShortByteString -#endif - --- - -instance IsomorphicTo (Vector a) (Vector a) where - to = id - -instance IsomorphicTo (Vector a) [a] where - to = Vector.fromList - -instance IsomorphicTo (Vector a) (Seq a) where - to = from @[a] . to - --- - -instance IsomorphicTo (Seq a) (Seq a) where - to = id - -instance IsomorphicTo (Seq a) [a] where - to = Seq.fromList - -instance IsomorphicTo (Seq a) (Vector a) where - to = from @[a] . to - --- - -instance IsomorphicTo (Set a) (Set a) where - to = id - -instance IsomorphicTo (Set Int) IntSet where - to = fromList . toList - --- - -instance IsomorphicTo IntSet IntSet where - to = id - -instance IsomorphicTo IntSet (Set Int) where - to = fromList . toList - --- - -instance IsomorphicTo (Map k v) (Map k v) where - to = id - -instance IsomorphicTo (Map Int v) (IntMap v) where - to = fromList . toList - --- - -instance IsomorphicTo (IntMap a) (IntMap a) where - to = id - -instance IsomorphicTo (IntMap v) (Map Int v) where - to = fromList . toList - --- - -instance IsomorphicTo (Maybe a) (Maybe a) where to = id - -instance IsomorphicTo (Either a b) (Either a b) where to = id - -instance IsomorphicTo (First a) (First a) where to = id - -instance IsomorphicTo (Last a) (Last a) where to = id - -instance IsomorphicTo (Product a) (Product a) where to = id - -instance IsomorphicTo (Sum a) (Sum a) where to = id - --- - -instance IsomorphicTo Bool Bool where to = id - -instance IsomorphicTo Char Char where to = id - -instance IsomorphicTo Double Double where to = id - -instance IsomorphicTo Float Float where to = id - -instance IsomorphicTo Int Int where to = id - -instance IsomorphicTo Int Word where to = fromIntegral - -instance IsomorphicTo Int16 Int16 where to = id - -instance IsomorphicTo Int16 Word16 where to = fromIntegral - -instance IsomorphicTo Int32 Int32 where to = id - -instance IsomorphicTo Int32 Word32 where to = fromIntegral - -instance IsomorphicTo Int64 Int64 where to = id - -instance IsomorphicTo Int64 Word64 where to = fromIntegral - -instance IsomorphicTo Int8 Int8 where to = id - -instance IsomorphicTo Int8 Word8 where to = fromIntegral - -instance IsomorphicTo Integer Integer where to = id - -instance IsomorphicTo Rational Rational where to = id - -instance IsomorphicTo Word Int where to = fromIntegral - -instance IsomorphicTo Word Word where to = id - -instance IsomorphicTo Word16 Int16 where to = fromIntegral - -instance IsomorphicTo Word16 Word16 where to = id - -instance IsomorphicTo Word32 Int32 where to = fromIntegral - -instance IsomorphicTo Word32 Word32 where to = id - -instance IsomorphicTo Word64 Int64 where to = fromIntegral - -instance IsomorphicTo Word64 Word64 where to = id - -instance IsomorphicTo Word8 Int8 where to = fromIntegral - -instance IsomorphicTo Word8 Word8 where to = id - --- - --- | --- 'to' in reverse direction. --- --- Particularly useful in combination with the @TypeApplications@ extension, --- where it allows to specify the input type, e.g.: --- --- > fromString :: IsomorphicTo a String => String -> a --- > fromString = from @String +-- = Partial conversions -- --- The first type application of the 'to' function on the other hand specifies --- the output data type. -from :: forall a b. (IsomorphicTo b a) => a -> b -from = to - --- | --- Ideally there should be a direct instance and this function --- should merely serve as a helper for defining instances --- by merely composing from other instances. +-- Atop of all said this library also captures the notion of smart constructors via the 'IsSome' class, which associates a total 'to' conversion with partial 'maybeFrom'. -- +-- This captures the codec relationship between types. -- E.g., -- --- > thru @String Proxy --- --- captures the following pattern: +-- - Every 'Int16' can be losslessly converted into 'Int32', but not every 'Int32' can be losslessly converted into 'Int16'. -- --- > from @String . to +-- - Every 'Text' can be converted into 'ByteString' via UTF-8 encoding, but not every 'ByteString' forms a valid UTF-8 sequence. -- --- However it is advised to use the conversion functions directly, --- since it makes the intent clearer and is actually shorter. -{-# INLINE thru #-} -thru :: (IsomorphicTo a b, IsomorphicTo a c) => Proxy a -> b -> c -thru proxy = from . flip asProxyTypeOf proxy . to +-- - Every URL can be uniquely represented as 'Text', but most 'Text's are not URLs unfortunately. +module IsomorphismClass + ( -- * Typeclasses + Is, + IsSome (..), + from, -{-# INLINE thruString #-} -thruString :: (IsomorphicTo String a, IsomorphicTo String b) => a -> b -thruString = from @String . to + -- * Optics + isSomePrism, + isIso, -{-# INLINE thruText #-} -thruText :: (IsomorphicTo Text a, IsomorphicTo Text b) => a -> b -thruText = from @Text . to + -- * Instance derivation -{-# INLINE thruList #-} -thruList :: forall a f g. (IsomorphicTo [a] (f a), IsomorphicTo [a] (g a)) => f a -> g a -thruList = from @[a] . to + -- | Proxy data-types useful for deriving various standard instances using the @DerivingVia@ extension. + module IsomorphismClass.Proxies, --- | A utility, which uses the 'Show' instance to produce a value --- that is isomorphic to 'String'. --- --- It lets you generalize over the functions like the following: --- --- > showAsText :: Show a => a -> Text --- > showAsText = showAs @Text --- --- > showAsBuilder :: Show a => a -> Builder --- > showAsBuilder = showAs @Builder -showAs :: forall b a. (IsomorphicTo String b, Show a) => a -> b -showAs = from . show + -- * Testing + module IsomorphismClass.Laws, + ) +where + +import IsomorphismClass.Classes +import IsomorphismClass.Laws +import IsomorphismClass.Optics +import IsomorphismClass.Proxies +import IsomorphismClass.Relations () diff --git a/library/IsomorphismClass/Classes.hs b/library/IsomorphismClass/Classes.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Classes.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/IsomorphismClass/Classes/Is.hs b/library/IsomorphismClass/Classes/Is.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Classes/Is.hs @@ -0,0 +1,48 @@ +module IsomorphismClass.Classes.Is where + +import IsomorphismClass.Classes.IsSome + +-- | Bidirectional conversion between two types with no loss of information. +-- +-- The bidirectionality is encoded via a recursive dependency with arguments +-- flipped. +-- +-- You can read the signature @Is a b@ as \"/B/ is /A/\". +-- +-- === Laws +-- +-- /B/ is isomorphic to /A/ if and only if there exists a conversion from /B/ +-- to /A/ ('to') and a conversion from /A/ to /B/ ('from') such that: +-- +-- - @'from' . 'to' = 'id'@ - For all values of /B/ converting from /B/ to /A/ +-- and then converting from /A/ to /B/ produces a value that is identical +-- to the original. +-- +-- - @'to' . 'from' = 'id'@ - For all values of /A/ converting from /A/ to /B/ +-- and then converting from /B/ to /A/ produces a value that is identical +-- to the original. +-- +-- For testing whether your instances conform to these laws use 'IsomorphismClass.isLawsProperties'. +-- +-- === Instance Definition +-- +-- For each pair of isomorphic types (/A/ and /B/) the compiler will require +-- you to define four instances, namely: @Is A B@ and @Is B A@ as well as @IsSome A B@ and @IsSome B A@. +class (IsSome a b, Is b a) => Is a b + +-- | Any type is isomorphic to itself. +instance Is a a + +-- | +-- 'to' in reverse direction. +-- +-- Particularly useful in combination with the @TypeApplications@ extension, +-- where it allows to specify the input type, e.g.: +-- +-- > fromText :: Is Text b => Text -> b +-- > fromText = from @Text +-- +-- The first type application of the 'to' function on the other hand specifies +-- the output data type. +from :: (Is a b) => a -> b +from = to diff --git a/library/IsomorphismClass/Classes/IsSome.hs b/library/IsomorphismClass/Classes/IsSome.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Classes/IsSome.hs @@ -0,0 +1,50 @@ +module IsomorphismClass.Classes.IsSome where + +import IsomorphismClass.Prelude + +-- | +-- Evidence that all values of type @sub@ form a subset of all values of type @sup@. +-- +-- [From Wikipedia](https://en.wikipedia.org/wiki/Subset): +-- +-- In mathematics, a set A is a subset of a set B if all elements of A are also elements of B; B is then a superset of A. It is possible for A and B to be equal; if they are unequal, then A is a proper subset of B. The relationship of one set being a subset of another is called inclusion (or sometimes containment). A is a subset of B may also be expressed as B includes (or contains) A or A is included (or contained) in B. A k-subset is a subset with k elements. +-- +-- === Laws +-- +-- ==== 'to' is injective +-- +-- For every two values of type @sub@ that are not equal converting with 'to' will always produce values that are not equal. +-- +-- > \(a, b) -> a == b || to a /= to b +-- +-- ==== 'maybeFrom' is an inverse of 'to' +-- +-- For all values of @sub@ converting to @sup@ and then attempting to convert back to @sub@ always succeeds and produces a value that is equal to the original. +-- +-- > \a -> maybeFrom (to a) == Just a +-- +-- For testing whether your instances conform to these laws use 'IsomorphismClass.isSomeLawsProperties'. +class IsSome sup sub where + -- | + -- Convert a value a subset type to a superset type. + -- + -- This function is injective non-surjective. + to :: sub -> sup + + -- | + -- [Partial inverse](https://en.wikipedia.org/wiki/Inverse_function#Partial_inverses) of 'to'. + -- + -- This function is a [partial bijection](https://en.wikipedia.org/wiki/Bijection#Generalization_to_partial_functions). + maybeFrom :: sup -> Maybe sub + default maybeFrom :: (IsSome sub sup) => sup -> Maybe sub + maybeFrom = Just . to + +-- | Every type is isomorphic to itself. +instance IsSome a a where + to = id + maybeFrom = Just . id + +-- | The empty set has no elements, and therefore is vacuously a subset of any set. +instance IsSome sup Void where + to = absurd + maybeFrom = const Nothing diff --git a/library/IsomorphismClass/Laws.hs b/library/IsomorphismClass/Laws.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Laws.hs @@ -0,0 +1,81 @@ +module IsomorphismClass.Laws + ( isSomeLawsProperties, + isLawsProperties, + ) +where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import Test.QuickCheck + +-- | +-- Properties testing whether an instance satisfies the laws of 'IsSome'. +-- +-- The instance is identified via the proxy types that you provide. +-- +-- E.g., here's how you can integrate it into an Hspec test-suite: +-- +-- > spec = do +-- > describe "IsSome laws" do +-- > traverse_ +-- > (uncurry prop) +-- > (isSomeLawsProperties @Int32 @Int16 Proxy Proxy) +isSomeLawsProperties :: + (IsSome a b, Eq a, Eq b, Show a, Arbitrary b, Show b) => + Proxy a -> + Proxy b -> + [(String, Property)] +isSomeLawsProperties superp subp = + [ ( "'to' is injective", + property \a b -> + a /= b ==> + to' a =/= to' b + ), + ( "'maybeFrom' is an inverse of 'to'", + property \a -> + maybeFrom' (to' a) === Just a + ) + ] + where + to' = as superp . to . as subp + maybeFrom' = fmap (as subp) . maybeFrom . as superp + as = flip asProxyTypeOf + +-- | +-- Properties testing whether an instance satisfies the laws of 'Is'. +-- +-- The instance is identified via the proxy types that you provide. +-- +-- E.g., here's how you can integrate it into an Hspec test-suite: +-- +-- > spec = do +-- > describe "Is laws" do +-- > traverse_ +-- > (uncurry prop) +-- > (isLawsProperties @Int32 @Word32 Proxy Proxy) +isLawsProperties :: + (Is a b, Eq a, Eq b, Arbitrary a, Show a, Arbitrary b, Show b) => + Proxy a -> + Proxy b -> + [(String, Property)] +isLawsProperties superp subp = + [ directedLaws "↻" superp subp, + directedLaws "↺" subp superp + ] + & mconcat + where + directedLaws prefix ap bp = + ( ( "Isomorphic: Law 1", + property \b -> + b === to (asProxyTypeOf (to (asProxyTypeOf b bp)) ap) + ) + : prefixEachName "Partially isomorphic: " (isSomeLawsProperties ap bp) + ) + & prefixEachName (prefix <> ": ") + +prefixEachName :: + String -> + [(String, Property)] -> + [(String, Property)] +prefixEachName prefix = + (fmap . first) (mappend prefix) diff --git a/library/IsomorphismClass/Optics.hs b/library/IsomorphismClass/Optics.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Optics.hs @@ -0,0 +1,17 @@ +module IsomorphismClass.Optics where + +import Data.Profunctor +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +-- | Van-Laarhoven-style Prism, compatible with the \"lens\" library. +isSomePrism :: (IsSome a b, Choice p, Applicative f) => p b (f b) -> p a (f a) +isSomePrism = + dimap + (\s -> maybe (Left s) Right (maybeFrom s)) + (either pure (fmap to)) + . right' + +-- | Van-Laarhoven-style Isomorphism, compatible with the \"lens\" library. +isIso :: (Is a b, Profunctor p, Functor f) => p b (f b) -> p a (f a) +isIso = dimap from (fmap to) diff --git a/library/IsomorphismClass/Prelude.hs b/library/IsomorphismClass/Prelude.hs --- a/library/IsomorphismClass/Prelude.hs +++ b/library/IsomorphismClass/Prelude.hs @@ -4,7 +4,6 @@ where import Control.Applicative as Exports -import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports @@ -55,7 +54,6 @@ import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports -import Data.Unique as Exports import Data.Vector as Exports (Vector) import Data.Version as Exports import Data.Void as Exports diff --git a/library/IsomorphismClass/Proxies.hs b/library/IsomorphismClass/Proxies.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Proxies.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/IsomorphismClass/Proxies/ViaIsSome.hs b/library/IsomorphismClass/Proxies/ViaIsSome.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Proxies/ViaIsSome.hs @@ -0,0 +1,58 @@ +module IsomorphismClass.Proxies.ViaIsSome where + +import IsomorphismClass.Classes.IsSome +import IsomorphismClass.Prelude +import qualified Test.QuickCheck as QuickCheck + +-- | +-- Helper for deriving common instances on types which have an instance of @'IsSome' sup@ using the @DerivingVia@ extension. +-- +-- E.g., +-- +-- > newtype Percent = Percent Double +-- > deriving newtype (Show, Eq, Ord) +-- > deriving (Read, IsString, Arbitrary) via (ViaIsSome Double Percent) +-- > +-- > instance IsSome Double Percent where +-- > to (Percent double) = double +-- > maybeFrom double = +-- > if double < 0 || double > 1 +-- > then Nothing +-- > else Just (Percent double) +-- +-- In the code above all the instances that are able to construct the values of 'Percent' are automatically derived based on the @IsSome Double Percent@ instance. +-- This guarantees that they only construct values that pass thru the checks defined in 'maybeFrom'. +newtype ViaIsSome sup sub = ViaIsSome sub + +instance (IsSome sup sub) => IsSome sup (ViaIsSome sup sub) where + to (ViaIsSome a) = to a + maybeFrom = fmap ViaIsSome . maybeFrom + +instance (IsSome sup sub, Show sup) => Show (ViaIsSome sup sub) where + show (ViaIsSome a) = show (to @sup a) + +instance (IsSome sup sub, Read sup) => Read (ViaIsSome sup sub) where + readPrec = do + sup <- readPrec + case maybeFrom @sup sup of + Just a -> pure (ViaIsSome a) + Nothing -> fail "Value is not from the subset" + +instance (IsSome sup sub, IsString sup) => IsString (ViaIsSome sup sub) where + fromString = + maybe (error "Value is not from the subset") ViaIsSome . maybeFrom @sup . fromString + +instance (IsSome sup sub, Eq sup) => Eq (ViaIsSome sup sub) where + (==) = on (==) (to @sup) + +instance (IsSome sup sub, Ord sup) => Ord (ViaIsSome sup sub) where + compare = on compare (to @sup) + +instance (IsSome sup sub, QuickCheck.Arbitrary sup) => QuickCheck.Arbitrary (ViaIsSome sup sub) where + arbitrary = + QuickCheck.suchThatMap QuickCheck.arbitrary (maybeFrom @sup) + shrink value = do + shrunkValue <- QuickCheck.shrink (to @sup value) + shrunkValue + & maybeFrom + & maybeToList diff --git a/library/IsomorphismClass/Relations.hs b/library/IsomorphismClass/Relations.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/IsomorphismClass/Relations/BoxedVectorAndList.hs b/library/IsomorphismClass/Relations/BoxedVectorAndList.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/BoxedVectorAndList.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.BoxedVectorAndList where + +import qualified Data.Vector +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome (Vector a) [a] where + to = Data.Vector.fromList + +instance IsSome [a] (Vector a) where + to = Data.Vector.toList + +instance Is (Vector a) [a] + +instance Is [a] (Vector a) diff --git a/library/IsomorphismClass/Relations/BoxedVectorAndSeq.hs b/library/IsomorphismClass/Relations/BoxedVectorAndSeq.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/BoxedVectorAndSeq.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.BoxedVectorAndSeq where + +import qualified Data.Sequence +import qualified Data.Vector +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome (Vector a) (Seq a) where + to = Data.Vector.fromList . toList + +instance IsSome (Seq a) (Vector a) where + to = Data.Sequence.fromList . Data.Vector.toList + +instance Is (Vector a) (Seq a) + +instance Is (Seq a) (Vector a) diff --git a/library/IsomorphismClass/Relations/ByteArrayAndByteString.hs b/library/IsomorphismClass/Relations/ByteArrayAndByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndByteString.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndByteString where + +import qualified Data.ByteString.Short +import qualified Data.Primitive.ByteArray +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.ByteArrayAndShortByteString () +import IsomorphismClass.Relations.ByteStringAndShortByteString () + +instance IsSome Data.Primitive.ByteArray.ByteArray ByteString where + to = to . to @Data.ByteString.Short.ShortByteString + +instance IsSome ByteString Data.Primitive.ByteArray.ByteArray where + to = to . to @Data.ByteString.Short.ShortByteString + +instance Is Data.Primitive.ByteArray.ByteArray ByteString + +instance Is ByteString Data.Primitive.ByteArray.ByteArray diff --git a/library/IsomorphismClass/Relations/ByteArrayAndLazyByteString.hs b/library/IsomorphismClass/Relations/ByteArrayAndLazyByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndLazyByteString.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndLazyByteString where + +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Primitive.ByteArray +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.ByteArrayAndShortByteString () +import IsomorphismClass.Relations.LazyByteStringAndShortByteString () + +instance IsSome Data.ByteString.Lazy.ByteString Data.Primitive.ByteArray.ByteArray where + to = to . to @Data.ByteString.Short.ShortByteString + +instance IsSome Data.Primitive.ByteArray.ByteArray Data.ByteString.Lazy.ByteString where + to = to . to @Data.ByteString.Short.ShortByteString + +instance Is Data.Primitive.ByteArray.ByteArray Data.ByteString.Lazy.ByteString + +instance Is Data.ByteString.Lazy.ByteString Data.Primitive.ByteArray.ByteArray diff --git a/library/IsomorphismClass/Relations/ByteArrayAndLazyByteStringBuilder.hs b/library/IsomorphismClass/Relations/ByteArrayAndLazyByteStringBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndLazyByteStringBuilder.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndLazyByteStringBuilder where + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Short +import qualified Data.Primitive.ByteArray +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.ByteArrayAndShortByteString () +import IsomorphismClass.Relations.LazyByteStringBuilderAndShortByteString () + +instance IsSome Data.Primitive.ByteArray.ByteArray Data.ByteString.Builder.Builder where + to = to . to @Data.ByteString.Short.ShortByteString + +instance IsSome Data.ByteString.Builder.Builder Data.Primitive.ByteArray.ByteArray where + to = to . to @Data.ByteString.Short.ShortByteString + +instance Is Data.Primitive.ByteArray.ByteArray Data.ByteString.Builder.Builder + +instance Is Data.ByteString.Builder.Builder Data.Primitive.ByteArray.ByteArray diff --git a/library/IsomorphismClass/Relations/ByteArrayAndShortByteString.hs b/library/IsomorphismClass/Relations/ByteArrayAndShortByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndShortByteString.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndShortByteString where + +import qualified Data.ByteString.Short +import qualified Data.ByteString.Short.Internal +import qualified Data.Primitive.ByteArray +import IsomorphismClass.Classes + +instance IsSome Data.ByteString.Short.ShortByteString Data.Primitive.ByteArray.ByteArray where + to (Data.Primitive.ByteArray.ByteArray array) = + Data.ByteString.Short.Internal.SBS array + +instance IsSome Data.Primitive.ByteArray.ByteArray Data.ByteString.Short.ShortByteString where + to (Data.ByteString.Short.Internal.SBS array) = + Data.Primitive.ByteArray.ByteArray array + +instance Is Data.Primitive.ByteArray.ByteArray Data.ByteString.Short.ShortByteString + +instance Is Data.ByteString.Short.ShortByteString Data.Primitive.ByteArray.ByteArray diff --git a/library/IsomorphismClass/Relations/ByteArrayAndTextArray.hs b/library/IsomorphismClass/Relations/ByteArrayAndTextArray.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndTextArray.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndTextArray where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.Primitive.ByteArray +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome Data.Primitive.ByteArray.ByteArray Data.Text.Array.Array where + to = IsomorphismClass.TextCompat.Array.toByteArray + +instance IsSome Data.Text.Array.Array Data.Primitive.ByteArray.ByteArray where + to = IsomorphismClass.TextCompat.Array.fromByteArray + +instance Is Data.Primitive.ByteArray.ByteArray Data.Text.Array.Array + +instance Is Data.Text.Array.Array Data.Primitive.ByteArray.ByteArray + +#endif diff --git a/library/IsomorphismClass/Relations/ByteArrayAndWord8List.hs b/library/IsomorphismClass/Relations/ByteArrayAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteArrayAndWord8List.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteArrayAndWord8List where + +import qualified Data.Primitive.ByteArray +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.ByteArrayAndShortByteString () + +instance IsSome Data.Primitive.ByteArray.ByteArray [Word8] where + to = fromList + +instance IsSome [Word8] Data.Primitive.ByteArray.ByteArray where + to = toList + +instance Is Data.Primitive.ByteArray.ByteArray [Word8] + +instance Is [Word8] Data.Primitive.ByteArray.ByteArray diff --git a/library/IsomorphismClass/Relations/ByteStringAndLazyByteString.hs b/library/IsomorphismClass/Relations/ByteStringAndLazyByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndLazyByteString.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndLazyByteString where + +import qualified Data.ByteString.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome ByteString Data.ByteString.Lazy.ByteString where + to = Data.ByteString.Lazy.toStrict + +instance IsSome Data.ByteString.Lazy.ByteString ByteString where + to = Data.ByteString.Lazy.fromStrict + +instance Is ByteString Data.ByteString.Lazy.ByteString + +instance Is Data.ByteString.Lazy.ByteString ByteString diff --git a/library/IsomorphismClass/Relations/ByteStringAndLazyByteStringBuilder.hs b/library/IsomorphismClass/Relations/ByteStringAndLazyByteStringBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndLazyByteStringBuilder.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndLazyByteStringBuilder where + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome ByteString Data.ByteString.Builder.Builder where + to = Data.ByteString.Lazy.toStrict . Data.ByteString.Builder.toLazyByteString + +instance IsSome Data.ByteString.Builder.Builder ByteString where + to = Data.ByteString.Builder.byteString + +instance Is Data.ByteString.Builder.Builder ByteString + +instance Is ByteString Data.ByteString.Builder.Builder diff --git a/library/IsomorphismClass/Relations/ByteStringAndShortByteString.hs b/library/IsomorphismClass/Relations/ByteStringAndShortByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndShortByteString.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndShortByteString where + +import qualified Data.ByteString.Short +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome ByteString Data.ByteString.Short.ShortByteString where + to = Data.ByteString.Short.fromShort + +instance IsSome Data.ByteString.Short.ShortByteString ByteString where + to = Data.ByteString.Short.toShort + +instance Is ByteString Data.ByteString.Short.ShortByteString + +instance Is Data.ByteString.Short.ShortByteString ByteString diff --git a/library/IsomorphismClass/Relations/ByteStringAndText.hs b/library/IsomorphismClass/Relations/ByteStringAndText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndText.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndText where + +import qualified Data.Text.Encoding +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome ByteString Text where + to = Data.Text.Encoding.encodeUtf8 + maybeFrom = either (const Nothing) Just . Data.Text.Encoding.decodeUtf8' diff --git a/library/IsomorphismClass/Relations/ByteStringAndTextArray.hs b/library/IsomorphismClass/Relations/ByteStringAndTextArray.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndTextArray.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndTextArray where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.ByteString.Short +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome ByteString Data.Text.Array.Array where + to = Data.ByteString.Short.fromShort . IsomorphismClass.TextCompat.Array.toShortByteString + +instance IsSome Data.Text.Array.Array ByteString where + to = IsomorphismClass.TextCompat.Array.fromShortByteString . Data.ByteString.Short.toShort + +instance Is ByteString Data.Text.Array.Array + +instance Is Data.Text.Array.Array ByteString + +#endif diff --git a/library/IsomorphismClass/Relations/ByteStringAndWord8List.hs b/library/IsomorphismClass/Relations/ByteStringAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ByteStringAndWord8List.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ByteStringAndWord8List where + +import qualified Data.ByteString +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome ByteString [Word8] where + to = Data.ByteString.pack + +instance IsSome [Word8] ByteString where + to = Data.ByteString.unpack + +instance Is ByteString [Word8] + +instance Is [Word8] ByteString diff --git a/library/IsomorphismClass/Relations/Int16AndWord16.hs b/library/IsomorphismClass/Relations/Int16AndWord16.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/Int16AndWord16.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.Int16AndWord16 where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Int16 Word16 where + to = fromIntegral + +instance IsSome Word16 Int16 where + to = fromIntegral + +instance Is Int16 Word16 + +instance Is Word16 Int16 diff --git a/library/IsomorphismClass/Relations/Int32AndWord32.hs b/library/IsomorphismClass/Relations/Int32AndWord32.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/Int32AndWord32.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.Int32AndWord32 where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Int32 Word32 where + to = fromIntegral + +instance IsSome Word32 Int32 where + to = fromIntegral + +instance Is Int32 Word32 + +instance Is Word32 Int32 diff --git a/library/IsomorphismClass/Relations/Int64AndWord64.hs b/library/IsomorphismClass/Relations/Int64AndWord64.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/Int64AndWord64.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.Int64AndWord64 where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Int64 Word64 where + to = fromIntegral + +instance IsSome Word64 Int64 where + to = fromIntegral + +instance Is Int64 Word64 + +instance Is Word64 Int64 diff --git a/library/IsomorphismClass/Relations/Int8AndWord8.hs b/library/IsomorphismClass/Relations/Int8AndWord8.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/Int8AndWord8.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.Int8AndWord8 where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Int8 Word8 where + to = fromIntegral + +instance IsSome Word8 Int8 where + to = fromIntegral + +instance Is Int8 Word8 + +instance Is Word8 Int8 diff --git a/library/IsomorphismClass/Relations/IntAndWord.hs b/library/IsomorphismClass/Relations/IntAndWord.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/IntAndWord.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.IntAndWord where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Int Word where + to = fromIntegral + +instance IsSome Word Int where + to = fromIntegral + +instance Is Int Word + +instance Is Word Int diff --git a/library/IsomorphismClass/Relations/IntMapAndMapOfInt.hs b/library/IsomorphismClass/Relations/IntMapAndMapOfInt.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/IntMapAndMapOfInt.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.IntMapAndMapOfInt where + +import qualified Data.IntMap.Strict +import qualified Data.Map.Strict +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome (Map Int v) (IntMap v) where + to = Data.Map.Strict.fromList . Data.IntMap.Strict.toList + +instance IsSome (IntMap v) (Map Int v) where + to = Data.IntMap.Strict.fromList . Data.Map.Strict.toList + +instance Is (Map Int v) (IntMap v) + +instance Is (IntMap v) (Map Int v) diff --git a/library/IsomorphismClass/Relations/IntSetAndSetOfInts.hs b/library/IsomorphismClass/Relations/IntSetAndSetOfInts.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/IntSetAndSetOfInts.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.IntSetAndSetOfInts where + +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome (Set Int) IntSet where + to = fromList . toList + +instance IsSome IntSet (Set Int) where + to = fromList . toList + +instance Is (Set Int) IntSet + +instance Is IntSet (Set Int) diff --git a/library/IsomorphismClass/Relations/LazyByteStringAndLazyByteStringBuilder.hs b/library/IsomorphismClass/Relations/LazyByteStringAndLazyByteStringBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringAndLazyByteStringBuilder.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringAndLazyByteStringBuilder where + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Lazy +import IsomorphismClass.Classes + +instance IsSome Data.ByteString.Lazy.ByteString Data.ByteString.Builder.Builder where + to = Data.ByteString.Builder.toLazyByteString + +instance IsSome Data.ByteString.Builder.Builder Data.ByteString.Lazy.ByteString where + to = Data.ByteString.Builder.lazyByteString + +instance Is Data.ByteString.Lazy.ByteString Data.ByteString.Builder.Builder + +instance Is Data.ByteString.Builder.Builder Data.ByteString.Lazy.ByteString diff --git a/library/IsomorphismClass/Relations/LazyByteStringAndLazyText.hs b/library/IsomorphismClass/Relations/LazyByteStringAndLazyText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringAndLazyText.hs @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringAndLazyText where + +import qualified Data.ByteString.Lazy +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Encoding +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.ByteString.Lazy.ByteString Data.Text.Lazy.Text where + to = Data.Text.Lazy.Encoding.encodeUtf8 + maybeFrom = either (const Nothing) Just . Data.Text.Lazy.Encoding.decodeUtf8' diff --git a/library/IsomorphismClass/Relations/LazyByteStringAndShortByteString.hs b/library/IsomorphismClass/Relations/LazyByteStringAndShortByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringAndShortByteString.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringAndShortByteString where + +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.ByteString.Lazy.ByteString Data.ByteString.Short.ShortByteString where + to = Data.ByteString.Lazy.fromStrict . Data.ByteString.Short.fromShort + +instance IsSome Data.ByteString.Short.ShortByteString Data.ByteString.Lazy.ByteString where + to = Data.ByteString.Short.toShort . Data.ByteString.Lazy.toStrict + +instance Is Data.ByteString.Lazy.ByteString Data.ByteString.Short.ShortByteString + +instance Is Data.ByteString.Short.ShortByteString Data.ByteString.Lazy.ByteString diff --git a/library/IsomorphismClass/Relations/LazyByteStringAndTextArray.hs b/library/IsomorphismClass/Relations/LazyByteStringAndTextArray.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringAndTextArray.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringAndTextArray where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome Data.ByteString.Lazy.ByteString Data.Text.Array.Array where + to = + Data.ByteString.Lazy.fromStrict + . Data.ByteString.Short.fromShort + . IsomorphismClass.TextCompat.Array.toShortByteString + +instance IsSome Data.Text.Array.Array Data.ByteString.Lazy.ByteString where + to = + IsomorphismClass.TextCompat.Array.fromShortByteString + . Data.ByteString.Short.toShort + . Data.ByteString.Lazy.toStrict + +instance Is Data.Text.Array.Array Data.ByteString.Lazy.ByteString + +instance Is Data.ByteString.Lazy.ByteString Data.Text.Array.Array + +#endif diff --git a/library/IsomorphismClass/Relations/LazyByteStringAndWord8List.hs b/library/IsomorphismClass/Relations/LazyByteStringAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringAndWord8List.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringAndWord8List where + +import qualified Data.ByteString.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.ByteString.Lazy.ByteString [Word8] where + to = Data.ByteString.Lazy.pack + +instance IsSome [Word8] Data.ByteString.Lazy.ByteString where + to = Data.ByteString.Lazy.unpack + +instance Is Data.ByteString.Lazy.ByteString [Word8] + +instance Is [Word8] Data.ByteString.Lazy.ByteString diff --git a/library/IsomorphismClass/Relations/LazyByteStringBuilderAndShortByteString.hs b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndShortByteString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndShortByteString.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringBuilderAndShortByteString where + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.ByteString.Builder.Builder Data.ByteString.Short.ShortByteString where + to = Data.ByteString.Builder.shortByteString + +instance IsSome Data.ByteString.Short.ShortByteString Data.ByteString.Builder.Builder where + to = Data.ByteString.Short.toShort . Data.ByteString.Lazy.toStrict . Data.ByteString.Builder.toLazyByteString + maybeFrom = Just . Data.ByteString.Builder.shortByteString + +instance Is Data.ByteString.Builder.Builder Data.ByteString.Short.ShortByteString + +instance Is Data.ByteString.Short.ShortByteString Data.ByteString.Builder.Builder diff --git a/library/IsomorphismClass/Relations/LazyByteStringBuilderAndTextArray.hs b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndTextArray.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndTextArray.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringBuilderAndTextArray where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome Data.ByteString.Builder.Builder Data.Text.Array.Array where + to = Data.ByteString.Builder.shortByteString . IsomorphismClass.TextCompat.Array.toShortByteString + +instance IsSome Data.Text.Array.Array Data.ByteString.Builder.Builder where + to = + IsomorphismClass.TextCompat.Array.fromShortByteString + . Data.ByteString.Short.toShort + . Data.ByteString.Lazy.toStrict + . Data.ByteString.Builder.toLazyByteString + +instance Is Data.Text.Array.Array Data.ByteString.Builder.Builder + +instance Is Data.ByteString.Builder.Builder Data.Text.Array.Array + +#endif diff --git a/library/IsomorphismClass/Relations/LazyByteStringBuilderAndWord8List.hs b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyByteStringBuilderAndWord8List.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyByteStringBuilderAndWord8List where + +import qualified Data.ByteString.Builder +import qualified Data.ByteString.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.ByteString.Builder.Builder [Word8] where + to = Data.ByteString.Builder.lazyByteString . Data.ByteString.Lazy.pack + +instance IsSome [Word8] Data.ByteString.Builder.Builder where + to = Data.ByteString.Lazy.unpack . Data.ByteString.Builder.toLazyByteString + +instance Is Data.ByteString.Builder.Builder [Word8] + +instance Is [Word8] Data.ByteString.Builder.Builder diff --git a/library/IsomorphismClass/Relations/LazyTextAndLazyTextBuilder.hs b/library/IsomorphismClass/Relations/LazyTextAndLazyTextBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextAndLazyTextBuilder.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextAndLazyTextBuilder where + +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.Text.Lazy.Text Data.Text.Lazy.Builder.Builder where + to = Data.Text.Lazy.Builder.toLazyText + maybeFrom = Just . Data.Text.Lazy.Builder.fromLazyText + +instance IsSome Data.Text.Lazy.Builder.Builder Data.Text.Lazy.Text where + to = Data.Text.Lazy.Builder.fromLazyText + maybeFrom = Just . Data.Text.Lazy.Builder.toLazyText + +instance Is Data.Text.Lazy.Text Data.Text.Lazy.Builder.Builder + +instance Is Data.Text.Lazy.Builder.Builder Data.Text.Lazy.Text diff --git a/library/IsomorphismClass/Relations/LazyTextAndStrictTextBuilder.hs b/library/IsomorphismClass/Relations/LazyTextAndStrictTextBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextAndStrictTextBuilder.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextAndStrictTextBuilder where + +#if MIN_VERSION_text(2,0,2) + +import qualified Data.Text.Encoding +import qualified Data.Text.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.Text.Lazy.Text Data.Text.Encoding.StrictBuilder where + to = Data.Text.Lazy.fromStrict . Data.Text.Encoding.strictBuilderToText + +instance IsSome Data.Text.Encoding.StrictBuilder Data.Text.Lazy.Text where + to = Data.Text.Encoding.textToStrictBuilder . Data.Text.Lazy.toStrict + +instance Is Data.Text.Lazy.Text Data.Text.Encoding.StrictBuilder + +instance Is Data.Text.Encoding.StrictBuilder Data.Text.Lazy.Text + +#endif diff --git a/library/IsomorphismClass/Relations/LazyTextAndString.hs b/library/IsomorphismClass/Relations/LazyTextAndString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextAndString.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextAndString where + +import qualified Data.Text.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.StringAndText () + +instance IsSome String Data.Text.Lazy.Text where + to = Data.Text.Lazy.unpack + maybeFrom = fmap Data.Text.Lazy.fromStrict . maybeFrom diff --git a/library/IsomorphismClass/Relations/LazyTextAndText.hs b/library/IsomorphismClass/Relations/LazyTextAndText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextAndText.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextAndText where + +import qualified Data.Text.Lazy +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.Text.Lazy.Text Text where + to = Data.Text.Lazy.fromStrict + +instance IsSome Text Data.Text.Lazy.Text where + to = Data.Text.Lazy.toStrict + +instance Is Data.Text.Lazy.Text Text + +instance Is Text Data.Text.Lazy.Text diff --git a/library/IsomorphismClass/Relations/LazyTextBuilderAndStrictTextBuilder.hs b/library/IsomorphismClass/Relations/LazyTextBuilderAndStrictTextBuilder.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextBuilderAndStrictTextBuilder.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextBuilderAndStrictTextBuilder where + +#if MIN_VERSION_text(2,0,2) + +import qualified Data.Text.Encoding +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.Text.Lazy.Builder.Builder Data.Text.Encoding.StrictBuilder where + to = Data.Text.Lazy.Builder.fromText . Data.Text.Encoding.strictBuilderToText + +instance IsSome Data.Text.Encoding.StrictBuilder Data.Text.Lazy.Builder.Builder where + to = Data.Text.Encoding.textToStrictBuilder . Data.Text.Lazy.toStrict . Data.Text.Lazy.Builder.toLazyText + +instance Is Data.Text.Lazy.Builder.Builder Data.Text.Encoding.StrictBuilder + +instance Is Data.Text.Encoding.StrictBuilder Data.Text.Lazy.Builder.Builder + +#endif diff --git a/library/IsomorphismClass/Relations/LazyTextBuilderAndString.hs b/library/IsomorphismClass/Relations/LazyTextBuilderAndString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextBuilderAndString.hs @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextBuilderAndString where + +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.StringAndText () + +instance IsSome String Data.Text.Lazy.Builder.Builder where + to = Data.Text.Lazy.unpack . Data.Text.Lazy.Builder.toLazyText + maybeFrom = fmap Data.Text.Lazy.Builder.fromText . maybeFrom diff --git a/library/IsomorphismClass/Relations/LazyTextBuilderAndText.hs b/library/IsomorphismClass/Relations/LazyTextBuilderAndText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/LazyTextBuilderAndText.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.LazyTextBuilderAndText where + +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Data.Text.Lazy.Builder.Builder Text where + to = Data.Text.Lazy.Builder.fromText + maybeFrom = Just . Data.Text.Lazy.toStrict . Data.Text.Lazy.Builder.toLazyText + +instance IsSome Text Data.Text.Lazy.Builder.Builder where + to = Data.Text.Lazy.toStrict . Data.Text.Lazy.Builder.toLazyText + maybeFrom = Just . Data.Text.Lazy.Builder.fromText + +instance Is Data.Text.Lazy.Builder.Builder Text + +instance Is Text Data.Text.Lazy.Builder.Builder diff --git a/library/IsomorphismClass/Relations/ListAndSeq.hs b/library/IsomorphismClass/Relations/ListAndSeq.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ListAndSeq.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ListAndSeq where + +import qualified Data.Sequence +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome [a] (Seq a) where + to = toList + +instance IsSome (Seq a) [a] where + to = Data.Sequence.fromList + +instance Is [a] (Seq a) + +instance Is (Seq a) [a] diff --git a/library/IsomorphismClass/Relations/ShortByteStringAndTextArray.hs b/library/IsomorphismClass/Relations/ShortByteStringAndTextArray.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ShortByteStringAndTextArray.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ShortByteStringAndTextArray where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.ByteString.Short +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome Data.ByteString.Short.ShortByteString Data.Text.Array.Array where + to = IsomorphismClass.TextCompat.Array.toShortByteString + +instance IsSome Data.Text.Array.Array Data.ByteString.Short.ShortByteString where + to = IsomorphismClass.TextCompat.Array.fromShortByteString + +instance Is Data.ByteString.Short.ShortByteString Data.Text.Array.Array + +instance Is Data.Text.Array.Array Data.ByteString.Short.ShortByteString + +#endif diff --git a/library/IsomorphismClass/Relations/ShortByteStringAndWord8List.hs b/library/IsomorphismClass/Relations/ShortByteStringAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/ShortByteStringAndWord8List.hs @@ -0,0 +1,18 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.ShortByteStringAndWord8List where + +import qualified Data.ByteString.Short +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import IsomorphismClass.Relations.ByteArrayAndShortByteString () + +instance IsSome [Word8] Data.ByteString.Short.ShortByteString where + to = Data.ByteString.Short.unpack + +instance IsSome Data.ByteString.Short.ShortByteString [Word8] where + to = Data.ByteString.Short.pack + +instance Is [Word8] Data.ByteString.Short.ShortByteString + +instance Is Data.ByteString.Short.ShortByteString [Word8] diff --git a/library/IsomorphismClass/Relations/StrictTextBuilderAndString.hs b/library/IsomorphismClass/Relations/StrictTextBuilderAndString.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/StrictTextBuilderAndString.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.StrictTextBuilderAndString where + +#if MIN_VERSION_text(2,0,2) + +import qualified Data.Text.Encoding +import IsomorphismClass.Classes +import IsomorphismClass.Relations.StringAndText () +import IsomorphismClass.Prelude + +instance IsSome String Data.Text.Encoding.StrictBuilder where + to = to . Data.Text.Encoding.strictBuilderToText + maybeFrom = fmap Data.Text.Encoding.textToStrictBuilder . maybeFrom + +#endif diff --git a/library/IsomorphismClass/Relations/StrictTextBuilderAndText.hs b/library/IsomorphismClass/Relations/StrictTextBuilderAndText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/StrictTextBuilderAndText.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.StrictTextBuilderAndText where + +#if MIN_VERSION_text(2,0,2) + +import qualified Data.Text.Encoding +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome Text Data.Text.Encoding.StrictBuilder where + to = Data.Text.Encoding.strictBuilderToText + +instance IsSome Data.Text.Encoding.StrictBuilder Text where + to = Data.Text.Encoding.textToStrictBuilder + +instance Is Text Data.Text.Encoding.StrictBuilder + +instance Is Data.Text.Encoding.StrictBuilder Text + +#endif diff --git a/library/IsomorphismClass/Relations/StringAndText.hs b/library/IsomorphismClass/Relations/StringAndText.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/StringAndText.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.StringAndText where + +import qualified Data.Text as Text +import IsomorphismClass.Classes +import IsomorphismClass.Prelude + +instance IsSome String Text where + to = Text.unpack + maybeFrom string = + -- FIXME: Optimize. + let text = Text.pack string + in if string == Text.unpack text + then Just text + else Nothing diff --git a/library/IsomorphismClass/Relations/TextArrayAndWord8List.hs b/library/IsomorphismClass/Relations/TextArrayAndWord8List.hs new file mode 100644 --- /dev/null +++ b/library/IsomorphismClass/Relations/TextArrayAndWord8List.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module IsomorphismClass.Relations.TextArrayAndWord8List where + +#if !MIN_VERSION_text(2,1,0) + +import qualified Data.ByteString.Short +import qualified Data.Text.Array +import IsomorphismClass.Classes +import IsomorphismClass.Prelude +import qualified IsomorphismClass.TextCompat.Array + +instance IsSome Data.Text.Array.Array [Word8] where + to = IsomorphismClass.TextCompat.Array.fromShortByteString . Data.ByteString.Short.pack + +instance IsSome [Word8] Data.Text.Array.Array where + to = Data.ByteString.Short.unpack . IsomorphismClass.TextCompat.Array.toShortByteString + +instance Is Data.Text.Array.Array [Word8] + +instance Is [Word8] Data.Text.Array.Array + +#endif diff --git a/library/IsomorphismClass/TextCompat/Array.hs b/library/IsomorphismClass/TextCompat/Array.hs --- a/library/IsomorphismClass/TextCompat/Array.hs +++ b/library/IsomorphismClass/TextCompat/Array.hs @@ -2,6 +2,9 @@ module IsomorphismClass.TextCompat.Array where +import qualified Data.ByteString.Short +import qualified Data.ByteString.Short.Internal +import qualified Data.Primitive.ByteArray import Data.Text.Array import GHC.Exts (ByteArray#) @@ -20,3 +23,23 @@ #else fromUnliftedByteArray = Array #endif + +{-# INLINE fromShortByteString #-} +fromShortByteString :: Data.ByteString.Short.ShortByteString -> Array +fromShortByteString (Data.ByteString.Short.Internal.SBS arr) = + fromUnliftedByteArray arr + +{-# INLINE toShortByteString #-} +toShortByteString :: Array -> Data.ByteString.Short.ShortByteString +toShortByteString a = + Data.ByteString.Short.Internal.SBS (toUnliftedByteArray a) + +{-# INLINE fromByteArray #-} +fromByteArray :: Data.Primitive.ByteArray.ByteArray -> Array +fromByteArray (Data.Primitive.ByteArray.ByteArray arr) = + fromUnliftedByteArray arr + +{-# INLINE toByteArray #-} +toByteArray :: Array -> Data.Primitive.ByteArray.ByteArray +toByteArray a = + Data.Primitive.ByteArray.ByteArray (toUnliftedByteArray a) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -18,10 +18,7 @@ allTests :: TestTree allTests = testGroup "All" $ - [ testPair @String @Text Proxy Proxy, - testPair @String @TextLazy.Text Proxy Proxy, - testPair @String @TextLazyBuilder.Builder Proxy Proxy, - testPair @[Word8] @ByteString Proxy Proxy, + [ testPair @[Word8] @ByteString Proxy Proxy, testPair @[Word8] @ByteStringLazy.ByteString Proxy Proxy, testPair @[Word8] @ByteStringShort.ShortByteString Proxy Proxy, testPair @[Word8] @ByteStringBuilder.Builder Proxy Proxy, @@ -30,15 +27,12 @@ testPair @[Word8] @(Vector Word8) Proxy Proxy, testPair @[Word8] @(Seq Word8) Proxy Proxy, testPair @Text @Text Proxy Proxy, - testPair @Text @String Proxy Proxy, testPair @Text @TextLazy.Text Proxy Proxy, testPair @Text @TextLazyBuilder.Builder Proxy Proxy, testPair @TextLazy.Text @TextLazy.Text Proxy Proxy, - testPair @TextLazy.Text @String Proxy Proxy, testPair @TextLazy.Text @Text Proxy Proxy, testPair @TextLazy.Text @TextLazyBuilder.Builder Proxy Proxy, testPair @TextLazyBuilder.Builder @TextLazyBuilder.Builder Proxy Proxy, - testPair @TextLazyBuilder.Builder @String Proxy Proxy, testPair @TextLazyBuilder.Builder @Text Proxy Proxy, testPair @TextLazyBuilder.Builder @TextLazy.Text Proxy Proxy, testPair @ByteString @ByteString Proxy Proxy, @@ -119,9 +113,15 @@ testPair @Word8 @Word8 Proxy Proxy ] -testPair :: forall a b. (IsomorphicTo a b, Eq a, Arbitrary a, Show a, Typeable a, Typeable b) => Proxy a -> Proxy b -> TestTree -testPair _ _ = - testProperty name $ \a -> - a === from @b (from @a a) +testPair :: (Is a b, Eq a, Eq b, Arbitrary a, Show a, Arbitrary b, Show b, Typeable a, Typeable b) => Proxy a -> Proxy b -> TestTree +testPair superp subp = + isLawsProperties superp subp + & fmap (uncurry testProperty) + & testGroup groupName where - name = show (typeOf (undefined :: a)) <> "/" <> show (typeOf (undefined :: b)) + groupName = + mconcat + [ show (typeOf (asProxyTypeOf undefined superp)), + "/", + show (typeOf (asProxyTypeOf undefined subp)) + ] diff --git a/test/Test/ExtraInstances.hs b/test/Test/ExtraInstances.hs --- a/test/Test/ExtraInstances.hs +++ b/test/Test/ExtraInstances.hs @@ -4,16 +4,10 @@ import qualified Data.ByteString.Builder as ByteStringBuilder import qualified Data.Text.Lazy.Builder as TextLazyBuilder -import qualified Data.Vector.Generic as VectorGeneric -import qualified Data.Vector.Primitive as VectorPrimitive import Rebase.Prelude import Test.QuickCheck import Test.QuickCheck.Instances () -instance (Arbitrary a, VectorPrimitive.Prim a) => Arbitrary (VectorPrimitive.Vector a) where - arbitrary = arbitraryVector - shrink = shrinkVector - instance Arbitrary TextLazyBuilder.Builder where arbitrary = TextLazyBuilder.fromText <$> arbitrary shrink = shrinkMap TextLazyBuilder.fromLazyText TextLazyBuilder.toLazyText @@ -24,9 +18,3 @@ instance Arbitrary ByteStringBuilder.Builder where arbitrary = ByteStringBuilder.byteString <$> arbitrary shrink = shrinkMap ByteStringBuilder.lazyByteString ByteStringBuilder.toLazyByteString - -arbitraryVector :: (VectorGeneric.Vector v a, Arbitrary a) => Gen (v a) -arbitraryVector = VectorGeneric.fromList <$> arbitrary - -shrinkVector :: (VectorGeneric.Vector v a, Arbitrary a) => v a -> [v a] -shrinkVector = fmap VectorGeneric.fromList . shrink . VectorGeneric.toList