text-encode 0.1.0.0 → 0.2.0.0
raw patch · 12 files changed
+907/−505 lines, 12 filesdep +text-convert
Dependencies added: text-convert
Files
- README.md +4/−0
- src/dev-main/Main.hs +1/−0
- src/dev/DevMain.hs +80/−50
- src/text-encode-aeson/Text/Encode/Aeson.hs +51/−42
- src/text-encode-cassava/Text/Encode/Cassava.hs +39/−24
- src/text-encode-http-api-data/Text/Encode/HttpApiData.hs +55/−38
- src/text-encode-persistent/Text/Encode/Persistent.hs +44/−29
- src/text-encode-postgresql-simple/Text/Encode/PostgresqlSimple.hs +22/−13
- src/text-encode-sqlite-simple/Text/Encode/SqliteSimple.hs +22/−13
- src/text-encode/Text/Encode.hs +418/−132
- src/text-encode/Text/Encode/Casing.hs +154/−155
- text-encode.cabal +17/−9
README.md view
@@ -15,3 +15,7 @@ - `text-encode-sqlite-simple` See the module documentation in `Text.Encode` for usage.++## Contribute++We use Fourmolu and Hlint, each with their default configuration.
src/dev-main/Main.hs view
@@ -1,2 +1,3 @@ module Main (main) where+ import DevMain (main)
src/dev/DevMain.hs view
@@ -1,72 +1,102 @@ {-# LANGUAGE OverloadedStrings #-} -module DevMain (main) where+module DevMain where import Text.Encode-import Text.Encode.Aeson ()-import Text.Encode.Cassava ()-import Text.Encode.Persistent ()+import Text.Encode.Aeson (AesonEncoding (..)) import Data.Aeson qualified as Aeson-import Data.ByteString.Lazy (LazyByteString)-import Data.Csv qualified as Cassava import Data.Functor (($>))-import Database.Persist qualified as Persistent+import Text.Convert (LazyByteString, asString) data MyType = MyTypeFoo | MyTypeBar | MyTypeFooBar deriving stock (Read, Show, Eq, Ord, Bounded, Enum)- deriving TextEncode- via DeriveTextEncode (Cased 'Pascal 'QuietSnake (DropPrefix "MyType" ReadShowEncode)) MyType- deriving- ( Aeson.FromJSON, Aeson.ToJSON- , Cassava.FromField, Cassava.ToField- , Persistent.PersistField- )- via ViaTextEncode MyType+ deriving+ (TextEncode)+ via ReadShowEncoding (Cased 'Pascal 'QuietSnake (DropPrefix "MyType" ())) MyType+ deriving+ ( Aeson.FromJSON+ , Aeson.ToJSON+ )+ via ViaTextEncode MyType -data YourType = YourTypeFoo | YourTypeBar | YourTypeFooBar- deriving stock (Read, Show, Eq, Ord, Bounded, Enum)- deriving TextEncode- via DeriveTextEncode BoundedEnumEncode YourType- deriving- ( Aeson.FromJSON, Aeson.ToJSON- , Cassava.FromField, Cassava.ToField- , Persistent.PersistField- )- via ViaTextEncode YourType+instance LazyByteStringPrimitives MyType where+ lazyByteStringEncode = encodeLazyByteString+ lazyByteStringDecode = decodeLazyByteString -myCases :: [(MyType, LazyByteString)]+data YourType = YourTypeZero | YourTypeOne | YourTypeTwo+ deriving stock (Read, Show, Eq, Ord, Bounded, Enum)+ deriving TextEncode via BoundedEnumEncoding YourType+ deriving (Aeson.FromJSON, Aeson.ToJSON) via ViaTextEncode YourType++instance LazyByteStringPrimitives YourType where+ lazyByteStringEncode = encodeLazyByteString+ lazyByteStringDecode = decodeLazyByteString++newtype TheirType = TheirType String+ deriving stock (Read, Show, Eq, Ord)+ deriving (Aeson.FromJSON, Aeson.ToJSON) via String+ deriving TextEncode via AesonEncoding TheirType++myCases :: [(MyType, LazyByteString, LazyByteString)] myCases =- [ (MyTypeFoo, "foo")- , (MyTypeBar, "bar")- , (MyTypeFooBar, "foo_bar")- ]+ [ let foo = "foo" in (MyTypeFoo, foo, quoted foo)+ , let bar = "bar" in (MyTypeBar, bar, quoted bar)+ , let fooBar = "foo_bar" in (MyTypeFooBar, fooBar, quoted fooBar)+ ] -yourCases :: [(YourType, LazyByteString)]+yourCases :: [(YourType, LazyByteString, LazyByteString)] yourCases =- [ (YourTypeFoo, "0")- , (YourTypeBar, "1")- , (YourTypeFooBar, "2")- ]+ [ let zero = "0" in (YourTypeZero, zero, quoted zero)+ , let one = "1" in (YourTypeOne, one, quoted one)+ , let two = "2" in (YourTypeTwo, two, quoted two)+ ] +theirCases :: [(TheirType, LazyByteString, LazyByteString)]+theirCases =+ [ let hello = "Hello, Aeson!" in (TheirType $ asString hello, quoted hello, quoted hello)+ , let nums = "1234" in (TheirType $ asString nums, quoted nums, quoted nums)+ , let none = "" in (TheirType $ asString none, quoted none, quoted none)+ ]+ quoted :: LazyByteString -> LazyByteString quoted = ("\"" <>) . (<> "\"") -checkCase :: (Eq a, Show a, Aeson.FromJSON a, Aeson.ToJSON a) => (a, LazyByteString) -> IO Int-checkCase (dec, enc) = do- let enc' = quoted enc- putStr $ "Checking:\t" <> show dec <> " <-> " <> show enc- let encodingWorks = Aeson.encode dec == enc'- let decodingWorks = Aeson.decode enc' == Just dec- if encodingWorks && decodingWorks- then putStrLn "\tPassed." $> 0- else putStrLn "\tFAILED!" $> 1+checkCase :: (Eq a, Show a, Aeson.FromJSON a, Aeson.ToJSON a, TextEncode a) => (a, LazyByteString, LazyByteString) -> IO Int+checkCase (dec, enc, enc') = do+ putStr $ take 55 $+ let msg = "Checking:\t" <> show dec <> " <-> " <> show enc+ in if length msg <= 55+ then msg <> repeat ' '+ else take 52 msg <> repeat '.'+ let+ encodingWorks = encodeLazyByteString dec == enc+ decodingWorks = decodeLazyByteString enc == Right dec+ encodingStringWorks = encodeString dec == asString enc+ decodingStringWorks = decodeString (asString enc) == Right dec+ jsonEncodingWorks = Aeson.encode dec == enc'+ jsonDecodingWorks = Aeson.decode enc' == Just dec+ everythingWorks =+ and+ [ jsonEncodingWorks+ , jsonDecodingWorks+ , encodingStringWorks+ , decodingStringWorks+ , encodingWorks+ , decodingWorks+ ]+ if everythingWorks+ then putStrLn "\tPassed." $> 0+ else putStrLn "\tFAILED!" $> 1 main :: IO () main = do- myFailures <- traverse checkCase myCases- yourFailures <- traverse checkCase yourCases- let failures = sum (myFailures <> yourFailures)- if failures == 0- then putStrLn "All tests passed."- else putStrLn $ "There were " <> show failures <> " failures."+ myFailures <- traverse checkCase myCases+ yourFailures <- traverse checkCase yourCases+ theirFailures <- traverse checkCase theirCases+ let failures = sum (myFailures <> yourFailures <> theirFailures)+ if failures == 0+ then putStrLn "All tests passed."+ else do+ putStrLn $ "There were " <> show failures <> " failures."+ error "Test suite failed!"
src/text-encode-aeson/Text/Encode/Aeson.hs view
@@ -1,60 +1,69 @@+{- | Derive 'FromJSON' and 'ToJSON' using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'FromJSON' MyType+ deriving via 'ViaTextEncode' MyType instance 'ToJSON' MyType+@+-} module Text.Encode.Aeson (- module Text.Encode,- JsonEncode,+ module Text.Encode,+ AesonEncoding (..), ) where import Text.Encode import Data.Aeson (- FromJSON (..),- FromJSONKey (..),- ToJSON (..),- ToJSONKey (..),- Value (..),- eitherDecode,- encode+ FromJSON (..),+ FromJSONKey (..),+ ToJSON (..),+ ToJSONKey (..),+ Value (..),+ eitherDecode,+ encode, )-import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.Coerce (coerce)-import Data.Text.Lazy qualified as LT-import Data.Text.Lazy.Encoding qualified as LTE import Data.Typeable (Typeable) instance (TextEncode a, Typeable a) => FromJSON (ViaTextEncode a) where- parseJSON (String txt) = either fail pure $ decodeText txt- parseJSON raw = fail $ typedError @a "parseJSON" "Expected String, got " $ encode raw+ parseJSON (String txt) = either fail pure $ decodeText txt+ parseJSON raw = fail $ typedError @a "parseJSON" "Expected String, got " $ encode raw -instance TextEncode a => ToJSON (ViaTextEncode a) where- toJSON = String . encodeText- toEncoding = toEncoding . encodeText+instance (TextEncode a) => ToJSON (ViaTextEncode a) where+ toJSON = String . encodeText+ toEncoding = toEncoding . encodeText - {-# INLINE toJSON #-}- {-# INLINE toEncoding #-}+ {-# INLINE toJSON #-}+ {-# INLINE toEncoding #-} instance (TextEncode a, Typeable a) => FromJSONKey (ViaTextEncode a)-instance TextEncode a => ToJSONKey (ViaTextEncode a)+instance (TextEncode a) => ToJSONKey (ViaTextEncode a) -data JsonEncode+{- | Derive 'TextEncode' using 'FromJSON' and 'ToJSON'. -instance (FromJSON a, ToJSON a) => TextEncode (DeriveTextEncode JsonEncode a) where- encodeLazyByteString = coerce $ encode @a- decodeLazyByteString = coerce $ eitherDecode @a- encodeByteString = LC8.toStrict . encodeLazyByteString- decodeByteString = decodeLazyByteString . LC8.fromStrict- encodeString = LC8.unpack <$> encodeLazyByteString- decodeString = decodeLazyByteString . LC8.pack- encodeLazyText = LTE.decodeLatin1 . encodeLazyByteString- decodeLazyText = decodeLazyByteString . LTE.encodeUtf8- encodeText = LT.toStrict . encodeLazyText- decodeText = decodeLazyText . LT.fromStrict+@+ data MyType = ... - {-# INLINE encodeLazyByteString #-}- {-# INLINE decodeLazyByteString #-}- {-# INLINE encodeByteString #-}- {-# INLINE decodeByteString #-}- {-# INLINE encodeString #-}- {-# INLINE decodeString #-}- {-# INLINE encodeLazyText #-}- {-# INLINE decodeLazyText #-}- {-# INLINE encodeText #-}- {-# INLINE decodeText #-}+ instance 'FromJSON' MyType where ...+ instance 'ToJSON' MyType where ...++ deriving via 'AesonEncoding' MyType instance 'TextEncode' MyType+@++__N.B.__ Do not use this on any type for which you are using 'ViaTextEncode' to+derive 'FromJSON' or 'ToJSON'. Your code will loop infinitely.+-}+newtype AesonEncoding a = AesonEncoding a+ deriving (FromJSON, ToJSON) via a++instance (FromJSON a, ToJSON a) => LazyByteStringPrimitives (AesonEncoding a) where+ lazyByteStringEncode = coerce $ encode @a+ lazyByteStringDecode = coerce $ eitherDecode @a++ {-# INLINE lazyByteStringEncode #-}+ {-# INLINE lazyByteStringDecode #-}++deriving via LazyByteStringEncoding (AesonEncoding a) instance (FromJSON a, ToJSON a) => TextEncode (AesonEncoding a)
src/text-encode-cassava/Text/Encode/Cassava.hs view
@@ -1,39 +1,54 @@+{- | Derive 'FromField' and 'ToField' using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'FromField' MyType+ deriving via 'ViaTextEncode' MyType instance 'ToField' MyType+@+-} module Text.Encode.Cassava (- module Text.Encode,- CsvEncode,+ module Text.Encode,+ CassavaEncoding (..), ) where import Text.Encode -import Data.ByteString.Char8 qualified as C8 import Data.Coerce (coerce) import Data.Csv (FromField (..), ToField (..), runParser)-import Data.Text.Encoding qualified as T -instance TextEncode a => FromField (ViaTextEncode a) where- parseField = either fail pure . coerce (decodeByteString @a)+instance (TextEncode a) => FromField (ViaTextEncode a) where+ parseField = either fail pure . coerce (decodeByteString @a)+ {-# INLINE parseField #-} - {-# INLINE parseField #-}+instance (TextEncode a) => ToField (ViaTextEncode a) where+ toField = coerce $ encodeByteString @a+ {-# INLINE toField #-} -instance TextEncode a => ToField (ViaTextEncode a) where- toField = coerce $ encodeByteString @a+{- | Derive 'TextEncode' using 'FromField' and 'ToField'. - {-# INLINE toField #-}+@+ data MyType = ... -data CsvEncode+ instance 'FromField' MyType where ...+ instance 'ToField' MyType where ... -instance (FromField a, ToField a) => TextEncode (DeriveTextEncode CsvEncode a) where- encodeByteString = coerce $ toField @a- decodeByteString = coerce $ runParser . parseField @a+ deriving via 'CassavaEncoding' MyType instance 'TextEncode' MyType+@ - encodeText = T.decodeLatin1 . encodeByteString- decodeText = decodeByteString . T.encodeUtf8- encodeString = C8.unpack . encodeByteString- decodeString = decodeByteString . C8.pack+__N.B.__ Do not use this on any type for which you are using 'ViaTextEncode' to+derive 'FromField' or 'ToField'. Your code will loop infinitely.+-}+newtype CassavaEncoding a = CassavaEncoding a+ deriving (FromField, ToField) via a - {-# INLINE encodeByteString #-}- {-# INLINE decodeByteString #-}- {-# INLINE encodeText #-}- {-# INLINE decodeText #-}- {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+instance (FromField a, ToField a) => ByteStringPrimitives (CassavaEncoding a) where+ byteStringEncode = coerce $ toField @a+ byteStringDecode = coerce $ runParser . parseField @a++ {-# INLINE byteStringEncode #-}+ {-# INLINE byteStringDecode #-}++deriving via ByteStringEncoding (CassavaEncoding a) instance (FromField a, ToField a) => TextEncode (CassavaEncoding a)
src/text-encode-http-api-data/Text/Encode/HttpApiData.hs view
@@ -1,59 +1,76 @@+{- | Derive 'FromFormKey', 'ToFormKey', 'FromHttpApiData', and 'ToHttpApiData'+using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'FromHttpApiData' MyType+ deriving via 'ViaTextEncode' MyType instance 'ToHttpApiData' MyType+@+-} module Text.Encode.HttpApiData (- module Text.Encode,- UrlEncode,+ module Text.Encode,+ HttpApiDataEncoding (..), ) where import Text.Encode import Data.Bifunctor (first) import Data.Coerce (coerce)-import Data.Text qualified as T-import Data.Text.Encoding qualified as TE+import Text.Convert (asByteString, asString, asText) import Web.FormUrlEncoded (FromFormKey (..), ToFormKey (..)) import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..)) -instance TextEncode a => ToFormKey (ViaTextEncode a) where- toFormKey = coerce $ encodeText @a+instance (TextEncode a) => ToFormKey (ViaTextEncode a) where+ toFormKey = coerce $ encodeText @a+ {-# INLINE toFormKey #-} - {-# INLINE toFormKey #-}+instance (TextEncode a) => FromFormKey (ViaTextEncode a) where+ parseFormKey = coerce $ first asText . decodeText @a+ {-# INLINE parseFormKey #-} -instance TextEncode a => FromFormKey (ViaTextEncode a) where- parseFormKey = coerce $ first T.pack . decodeText @a+instance (TextEncode a) => ToHttpApiData (ViaTextEncode a) where+ toUrlPiece = coerce $ encodeText @a+ toHeader = asByteString . toUrlPiece+ toQueryParam = toUrlPiece - {-# INLINE parseFormKey #-}+ {-# INLINE toUrlPiece #-}+ {-# INLINE toHeader #-}+ {-# INLINE toQueryParam #-} -instance TextEncode a => ToHttpApiData (ViaTextEncode a) where- toUrlPiece = coerce $ encodeText @a- toHeader = TE.encodeUtf8 . toUrlPiece- toQueryParam = toUrlPiece+instance (TextEncode a) => FromHttpApiData (ViaTextEncode a) where+ parseUrlPiece = coerce $ first asText . decodeText @a+ parseHeader = parseUrlPiece . asText+ parseQueryParam = parseUrlPiece - {-# INLINE toUrlPiece #-}- {-# INLINE toHeader #-}- {-# INLINE toQueryParam #-}+ {-# INLINE parseUrlPiece #-}+ {-# INLINE parseHeader #-}+ {-# INLINE parseQueryParam #-} -instance TextEncode a => FromHttpApiData (ViaTextEncode a) where- parseUrlPiece = coerce $ first T.pack . decodeText @a- parseHeader = parseUrlPiece . TE.decodeLatin1- parseQueryParam = parseUrlPiece+{- | Derive 'TextEncode' using 'FromHttpApiData' and 'ToHttpApiData'. - {-# INLINE parseUrlPiece #-}- {-# INLINE parseHeader #-}- {-# INLINE parseQueryParam #-}+@+ data MyType = ... -data UrlEncode+ instance 'FromHttpApiData' MyType where ...+ instance 'ToHttpApiData' MyType where ... -instance (FromHttpApiData a, ToHttpApiData a) => TextEncode (DeriveTextEncode UrlEncode a) where- encodeText = coerce $ toUrlPiece @a- decodeText = coerce $ first T.unpack . parseUrlPiece @a+ deriving via 'HttpApiDataEncoding' MyType instance 'TextEncode' MyType+@ - encodeString = T.unpack . encodeText- decodeString = decodeText . T.pack- encodeByteString = TE.encodeUtf8 . encodeText- decodeByteString = decodeText . TE.decodeLatin1+__N.B.__ Do not use this on any type for which you are using 'ViaTextEncode' to+derive 'FromHttpApiData' or 'ToHttpApiData'. Your code will loop infinitely.+-}+newtype HttpApiDataEncoding a = HttpApiDataEncoding a+ deriving (FromHttpApiData, ToHttpApiData) via a - {-# INLINE encodeText #-}- {-# INLINE decodeText #-}- {-# INLINE encodeString #-}- {-# INLINE decodeString #-}- {-# INLINE encodeByteString #-}- {-# INLINE decodeByteString #-}+instance (FromHttpApiData a, ToHttpApiData a) => TextPrimitives (HttpApiDataEncoding a) where+ textEncode = toUrlPiece+ textDecode = first asString . parseUrlPiece++ {-# INLINE textEncode #-}+ {-# INLINE textDecode #-}++deriving via TextEncoding (HttpApiDataEncoding a) instance (FromHttpApiData a, ToHttpApiData a) => TextEncode (HttpApiDataEncoding a)
src/text-encode-persistent/Text/Encode/Persistent.hs view
@@ -1,42 +1,57 @@+{- | Derive 'PersistField' using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'PersistField' MyType+@+-} module Text.Encode.Persistent (- module Text.Encode,- PersistentEncode,+ module Text.Encode,+ PersistentEncode (..), ) where import Text.Encode -import Data.Bifunctor-import Data.Coerce-import Data.Text qualified as T-import Data.Text.Encoding qualified as TE-import Data.Typeable-import Database.Persist.Class-import Database.Persist.PersistValue+import Data.Bifunctor (first)+import Data.Coerce (coerce)+import Data.Typeable (Typeable)+import Database.Persist.Class (PersistField (..))+import Database.Persist.PersistValue (PersistValue (..))+import Text.Convert (asString, asText) instance (TextEncode a, Typeable a) => PersistField (ViaTextEncode a) where- {-# INLINE toPersistValue #-}- toPersistValue = coerce $ PersistText . encodeText @(ViaTextEncode a)+ {-# INLINE toPersistValue #-}+ toPersistValue = coerce $ PersistText . encodeText @(ViaTextEncode a) - fromPersistValue (PersistText bs) = coerce $ first T.pack $ decodeText @(ViaTextEncode a) bs- fromPersistValue x = Left $ T.pack $ "DeriveTextEncode PersistentEncode requires PersistText: " <> show x+ fromPersistValue (PersistText bs) = coerce $ first asText $ decodeText @(ViaTextEncode a) bs+ fromPersistValue x = Left $ asText $ "DeriveTextEncode PersistentEncode requires PersistText: " <> show x -data PersistentEncode+{- | Derive 'TextEncode' using 'PersistField'. -instance PersistField a => TextEncode (DeriveTextEncode PersistentEncode a) where- encodeText (DeriveTextEncode x) =- case toPersistValue x of- (PersistText txt) -> txt- x' -> error $ "DeriveTextEncode PersistentEncode requires PersistText: " <> show x'+@+ data MyType = ... - decodeText = bimap T.unpack DeriveTextEncode . fromPersistValue . PersistText+ instance 'FromPersistField' MyType where ... - encodeByteString = TE.encodeUtf8 . encodeText- decodeByteString = decodeText . TE.decodeLatin1- encodeString = T.unpack . encodeText- decodeString = decodeText . T.pack+ deriving via 'PersistentEncoding' MyType instance 'TextEncode' MyType+@ - {-# INLINE decodeText #-}- {-# INLINE encodeByteString #-}- {-# INLINE decodeByteString #-}- {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+__N.B.__ Do not use this on any type for which you are using 'ViaTextEncode' to+derive 'PersistField'. Your code will loop infinitely.+-}+newtype PersistentEncode a = PersistentEncode a+ deriving (PersistField) via a++instance (PersistField a) => TextPrimitives (PersistentEncode a) where+ textEncode x =+ case toPersistValue x of+ (PersistText txt) -> txt+ x' -> error $ "PersistentEncode requires PersistText: " <> show x'++ textDecode = first asString . fromPersistValue . PersistText+ {-# INLINE textDecode #-}++deriving via TextEncoding (PersistentEncode a) instance (PersistField a) => TextEncode (PersistentEncode a)
src/text-encode-postgresql-simple/Text/Encode/PostgresqlSimple.hs view
@@ -1,6 +1,17 @@+{- | Derive 'FromField' and 'ToField' using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'FromField' MyType+ deriving via 'ViaTextEncode' MyType instance 'ToField' MyType+@+-} module Text.Encode.PostgresqlSimple (- module Text.Encode,- TextEncodePostgresqlSimpleError,+ module Text.Encode,+ TextEncodePostgresqlSimpleError (..), ) where import Text.Encode@@ -8,25 +19,23 @@ import Control.Exception (Exception) import Control.Monad ((<=<)) import Data.Coerce (coerce)-import Data.Text qualified as T import Data.Typeable (Typeable) import Database.PostgreSQL.Simple.FromField (FromField (..), conversionError) import Database.PostgreSQL.Simple.ToField (ToField (..))+import Text.Convert (Text) newtype TextEncodePostgresqlSimpleError = TextEncodePostgresqlSimpleError String- deriving (Show)+ deriving (Show) instance Exception TextEncodePostgresqlSimpleError instance (TextEncode a, Typeable a) => FromField (ViaTextEncode a) where- fromField f =- either (conversionError . TextEncodePostgresqlSimpleError) (pure . ViaTextEncode)- . decodeText @a- <=< fromField @T.Text f-- {-# INLINE fromField #-}+ fromField f =+ either (conversionError . TextEncodePostgresqlSimpleError) (pure . ViaTextEncode)+ . decodeText @a+ <=< fromField @Text f+ {-# INLINE fromField #-} instance (TextEncode a, Typeable a) => ToField (ViaTextEncode a) where- toField = coerce $ toField . encodeText @a-- {-# INLINE toField #-}+ toField = coerce $ toField . encodeText @a+ {-# INLINE toField #-}
src/text-encode-sqlite-simple/Text/Encode/SqliteSimple.hs view
@@ -1,6 +1,17 @@+{- | Derive 'FromField' and 'ToField' using 'TextEncode'.++@+ data MyType = ...++ instance 'TextEncode' MyType where ...++ deriving via 'ViaTextEncode' MyType instance 'FromField' MyType+ deriving via 'ViaTextEncode' MyType instance 'ToField' MyType+@+-} module Text.Encode.SqliteSimple (- module Text.Encode,- TextEncodeSqliteSimpleError,+ module Text.Encode,+ TextEncodeSqliteSimpleError (..), ) where import Text.Encode@@ -8,26 +19,24 @@ import Control.Exception (Exception, toException) import Control.Monad ((<=<)) import Data.Coerce (coerce)-import Data.Text qualified as T import Data.Typeable (Typeable) import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.Ok (Ok (..)) import Database.SQLite.Simple.ToField (ToField (..))+import Text.Convert (Text) newtype TextEncodeSqliteSimpleError = TextEncodeSqliteSimpleError String- deriving (Show)+ deriving (Show) instance Exception TextEncodeSqliteSimpleError instance (TextEncode a, Typeable a) => FromField (ViaTextEncode a) where- fromField =- either (Errors . pure . toException . TextEncodeSqliteSimpleError) (pure . ViaTextEncode)- . decodeText @a- <=< fromField @T.Text-- {-# INLINE fromField #-}+ fromField =+ either (Errors . pure . toException . TextEncodeSqliteSimpleError) (pure . ViaTextEncode)+ . decodeText @a+ <=< fromField @Text+ {-# INLINE fromField #-} instance (TextEncode a, Typeable a) => ToField (ViaTextEncode a) where- toField = coerce $ toField . encodeText @a-- {-# INLINE toField #-}+ toField = coerce $ toField . encodeText @a+ {-# INLINE toField #-}
src/text-encode/Text/Encode.hs view
@@ -1,169 +1,455 @@--- | This module provides classes and newtypes for deriving uniform textual encodings.------ An instance @'TextEncode' A@ defines a uniform textual representation for data of type @A@.--- Writing instances is usually straightforward, or they may be derived using 'DeriveTextEncode'.--- Use 'ViaTextEncode' to derive instances of other classes based on a type's 'TextEncode' instance.------ For example,--- @--- import Text.Encode------ import Text.Encode.Aeson ()--- import Text.Encode.Cassava ()--- import Text.Encode.Persistent ()------ data MyType = MyTypeFoo | MyTypeBar | MyTypeFooBar--- deriving stock (Read, Show)--- deriving 'TextEncode'--- via 'DeriveTextEncode' ('Cased' 'Pascal' 'QuietSnake' ('DropPrefix' "MyType" 'ReadShowEncode')) MyType--- deriving--- ( Aeson.FromJSON, Aeson.ToJSON--- , Cassava.FromField, Cassava.ToField--- , Persistent.PersistField--- )--- via 'ViaTextEncode' MyType--- @------ This will derive a 'TextEncode' instance for @MyType@ based on the stock 'Read' and 'Show' instances,--- modified by the 'Cased' and 'DropPrefix' options. Uniform, mutually-consistent instances for Aeson,--- Cassava, and Persistent classes are then derived from the derived 'TextEncode' instance.+{- | This module provides classes and newtypes for deriving uniform textual+encodings.++An instance @'TextEncode' A@ defines a uniform textual representation for data+of type @A@. Writing instances is usually straightforward, or they may be+derived using 'DeriveTextEncode'. Use 'ViaTextEncode' to derive instances of+other classes based on a type's 'TextEncode' instance.++For example,+@+ import Text.Encode++ import Text.Encode.Aeson ()+ import Text.Encode.Cassava ()+ import Text.Encode.Persistent ()++ data MyType = MyTypePrimitives | MyTypeBar | MyTypePrimitivesBar+ deriving stock (Read, Show)+ deriving 'TextEncode'+ via 'ReadShowEncoding' ('Cased' 'Pascal' 'QuietSnake' ('DropPrefix' "MyType" ())) MyType+ deriving+ ( Aeson.FromJSON, Aeson.ToJSON+ , Cassava.FromField, Cassava.ToField+ , Persistent.PersistField+ )+ via 'ViaTextEncode' MyType+@++This will derive a 'TextEncode' instance for @MyType@ based on the stock 'Read'+and 'Show' instances, modified by the 'Cased' and 'DropPrefix' options. Uniform,+mutually-consistent instances for Aeson, Cassava, and Persistent classes are+then derived from the derived 'TextEncode' instance.++__N.B.__ Using 'Cased' or 'DropPrefix' will cause create intermediate 'String'+values when serializing and deserializing, which may impact performance. In+practice, these 'String' values are short, and they're used over a relatively+high latency network, so the performance impact is usually negligible. In the+rare case that performance is a concern, there are a few options:+1. Use 'AesonEncoding' to derive 'TextEncode' for a type that efficient+ 'FromJSON' and 'ToJSON' instances (such as generated by Template Haskell).+2. Derive 'TextEncode' using 'BoundedEnumEncoding'. The representation will+ consist of an integer, still encoded as a 'String', but without any+ transformations. Serialization will use 'fromEnum' and 'show'.+ Deserialization will use 'readMaybe' and 'toEnum'.+3. Write a custom 'TextEncode' instance. Depending on the particulars of the+ functions you are using to send data over the wire, you probably want to+ write your instance in terms of 'encodeLazyByteString' (internally using a+ 'Builder') and 'decodeLazyByteString'. With optimizations,+ @'lazyByteString' . 'toLazyByteString'@ on 'Builder' will fuse to 'id' and+ be compiled away.+4. Consider using a library designed for high-performance binary serialization,+ such as _binary_, for these specific use cases.+-} module Text.Encode (- -- * Textual Encodings- TextEncode (..),- -- * Deriving 'TextEncode'- DeriveTextEncode (..),- -- ** Base encodings- BoundedEnumEncode,- ReadShowEncode,- -- ** Add or remove prefixes- DropPrefix,- AddPrefix,- -- ** Transform casing- Casing (..),- CaseConversion (..),- Cased,- -- * Deriving other classes- ViaTextEncode (..),- -- * Utilities- typedError,- decodeError,- maybeDecode,+ -- * Textual Encodings+ TextEncode (..),++ -- * Deriving 'TextEncode'++ -- ** 'String'-based encodings+ BoundedEnumEncoding (..),+ ReadShowEncoding (..),+ DropPrefix,+ AddPrefix,+ Casing (..),+ CaseConversion (..),+ Cased,++ -- ** Specialized encodings+ ByteStringEncoding (..),+ ByteStringPrimitives (..),+ LazyByteStringEncoding (..),+ LazyByteStringPrimitives (..),+ TextEncoding (..),+ TextPrimitives (..),+ LazyTextEncoding (..),+ LazyTextPrimitives (..),++ -- * Deriving other classes+ ViaTextEncode (..),++ -- * Utilities+ FunctionName,+ Message,+ Input,+ typedError,+ decodeError,+ maybeDecode, ) where import Text.Encode.Casing import Control.Monad (guard, (<=<))-import Data.ByteString.Char8 qualified as C8-import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.Coerce (coerce) import Data.Kind (Type)-import Data.Text qualified as T-import Data.Text.Lazy qualified as LT-import Data.Typeable (Typeable, Proxy (..), typeRep)+import Data.Typeable (Proxy (..), Typeable, typeRep) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+import Text.Convert (+ ByteString,+ LazyByteString,+ LazyText,+ Text,+ asByteString,+ asLazyByteString,+ asLazyText,+ asString,+ asText,+ ) import Text.Read (readMaybe) --- | An instance @'TextEncode' a@ defines a uniform textual representation for data of type @a@.------ Instances are assumed to follow these mutual-coherence properties:--- * @decodeString . encodeString === Right@--- * @fmap encodeString . decodeString === Right@--- * @decodeText . "Data.Text".'pack' . encodeString === Right@--- * @fmap encodeString . decodeByteString === Right . "Data.ByteString.Char8".'unpack'@--- and permutations thereof.------ Mutually-coherent default definitions of the methods are provided, though--- users may supply their own implementations for performance reasons.--- It is the user's responsibility to ensure that these definitions mutually cohere.+{- | An instance @'TextEncode' A@ defines a uniform textual representation for+data of type @A@.++Instances are assumed to follow these mutual-coherence properties:+* @decodeString . encodeString === Right@+* @fmap encodeString . decodeString === Right@+* @decodeText . "Data.Text".'pack' . encodeString === Right@+* @fmap encodeString . decodeByteString === Right . "Data.ByteString.Char8".'unpack'@+and permutations thereof.++Mutually-coherent default definitions of the methods are provided, though+users may supply their own implementations for performance reasons. It is the+user's responsibility to ensure that these definitions mutually cohere.++Minimal definitiions consist of 'encodeString' and 'decodeString'. To define+an instance based on a textual type other than 'String', see the specialized+encodings:+* 'ByteStringEncoding',+* 'LazyByteStringEncoding',+* 'TextEncoding',+* 'LazyTextEncoding'.+-} class TextEncode a where- {-# MINIMAL encodeString, decodeString #-}- encodeString :: a -> String- decodeString :: String -> Either String a- encodeByteString :: a -> C8.ByteString- decodeByteString :: C8.ByteString -> Either String a- encodeLazyByteString :: a -> LC8.ByteString- decodeLazyByteString :: LC8.ByteString -> Either String a- encodeText :: a -> T.Text- decodeText :: T.Text -> Either String a- encodeLazyText :: a -> LT.Text- decodeLazyText :: LT.Text -> Either String a+ {-# MINIMAL encodeString, decodeString #-}+ encodeString :: a -> String+ decodeString :: String -> Either String a - encodeText = T.pack . encodeString- decodeText = decodeString . T.unpack- encodeLazyText = LT.fromStrict . encodeText- decodeLazyText = decodeText . LT.toStrict- encodeByteString = C8.pack . encodeString- decodeByteString = decodeString . C8.unpack- encodeLazyByteString = LC8.fromStrict . encodeByteString- decodeLazyByteString = decodeByteString . LC8.toStrict+ encodeByteString :: a -> ByteString+ decodeByteString :: ByteString -> Either String a - {-# INLINE encodeByteString #-}- {-# INLINE decodeByteString #-}- {-# INLINE encodeLazyByteString #-}- {-# INLINE decodeLazyByteString #-}- {-# INLINE encodeText #-}- {-# INLINE decodeText #-}- {-# INLINE encodeLazyText #-}- {-# INLINE decodeLazyText #-}+ encodeLazyByteString :: a -> LazyByteString+ decodeLazyByteString :: LazyByteString -> Either String a --- | Derive instances of various classes based on an instance of 'TextEncode'.-newtype ViaTextEncode a = ViaTextEncode a- deriving TextEncode via a+ encodeText :: a -> Text+ decodeText :: Text -> Either String a -instance TextEncode a => Show (ViaTextEncode a) where- show (ViaTextEncode a) = encodeString a+ encodeLazyText :: a -> LazyText+ decodeLazyText :: LazyText -> Either String a -instance TextEncode a => Read (ViaTextEncode a) where- readsPrec _ = either (const []) (pure . (, "") . ViaTextEncode) . decodeString+ encodeText = asText . encodeString+ decodeText = decodeString . asString -newtype DeriveTextEncode (opt :: Type) a = DeriveTextEncode a- deriving (Eq, Ord, Read, Show, Bounded, Enum) via a+ encodeLazyText = asLazyText . encodeString+ decodeLazyText = decodeString . asString -data BoundedEnumEncode+ encodeByteString = asByteString . encodeString+ decodeByteString = decodeString . asString -instance (Bounded a, Enum a, Typeable a) => TextEncode (DeriveTextEncode BoundedEnumEncode a) where- encodeString = show . fromEnum- decodeString = coerce $ maybeDecode @a $ toEnumMaybe <=< readMaybe+ encodeLazyByteString = asLazyByteString . encodeString+ decodeLazyByteString = decodeString . asString - {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+ {-# INLINE encodeByteString #-}+ {-# INLINE decodeByteString #-}+ {-# INLINE encodeLazyByteString #-}+ {-# INLINE decodeLazyByteString #-}+ {-# INLINE encodeText #-}+ {-# INLINE decodeText #-}+ {-# INLINE encodeLazyText #-}+ {-# INLINE decodeLazyText #-} -data ReadShowEncode+{- | Derive instances of various classes based on an instance of 'TextEncode'. -instance (Read a, Show a, Typeable a) => TextEncode (DeriveTextEncode ReadShowEncode a) where- encodeString = show- decodeString = coerce $ maybeDecode @a readMaybe+@+ data MyType = ... - {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+ instance 'TextEncode' MyType where ... + deriving via 'ViaTextEncode' MyType instance FromHttpApiData MyType+ deriving via 'ViaTextEncode' MyType instance ToHttpApiData MyType+ deriving via 'ViaTextEncode' MyType instance PersistField MyType+@++See the following modules:+* "Text.Encode.Aeson"+* "Text.Encode.Cassava"+* "Text.Encode.HttpApiData"+* "Text.Encode.Persistent"+* "Text.Encode.PostgresqlSimple"+* "Text.Encode.SqliteSimple"+-}+newtype ViaTextEncode a = ViaTextEncode a+ deriving (TextEncode) via a++instance (TextEncode a) => Show (ViaTextEncode a) where+ show (ViaTextEncode a) = encodeString a++instance (TextEncode a) => Read (ViaTextEncode a) where+ readsPrec _ = either (const []) (pure . (,"") . ViaTextEncode) . decodeString++{- | Derive 'TextEncode' using 'Read' and 'Show'.++@+ data MyType = MyTypeFoo | MyTypeBar | MyTypeFooBar+ deriving stock (Read, Show)+ deriving TextEncode+ via ReadShowEncoding+ (Cased Pascal QuietSnake (DropPrefix "MyType" ()))+ MyType+@+-}+newtype ReadShowEncoding opt a = ReadShowEncoding a+ deriving (Read, Show) via a++instance (Read a, Show a, Typeable a) => TextEncode (ReadShowEncoding () a) where+ encodeString = show+ decodeString = coerce $ maybeDecode @a readMaybe++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}+ data DropPrefix (pfx :: Symbol) (opt :: Type) -instance (KnownSymbol pfx, TextEncode (DeriveTextEncode opt a)) => TextEncode (DeriveTextEncode (DropPrefix pfx opt) a) where- encodeString = coerce $ dropPfx @pfx . encodeString @(DeriveTextEncode opt a)- decodeString = coerce $ decodeString @(DeriveTextEncode opt a) . (symbolVal (Proxy @pfx) <>)+instance (KnownSymbol pfx, TextEncode (ReadShowEncoding opt a)) => TextEncode (ReadShowEncoding (DropPrefix pfx opt) a) where+ encodeString = coerce $ dropPfx @pfx . encodeString @(ReadShowEncoding opt a)+ decodeString = coerce $ decodeString @(ReadShowEncoding opt a) . (symbolVal (Proxy @pfx) <>) - {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-} data AddPrefix (pfx :: Symbol) (opt :: Type) -instance (KnownSymbol pfx, TextEncode (DeriveTextEncode opt a)) => TextEncode (DeriveTextEncode (AddPrefix pfx opt) a) where- encodeString = coerce $ (symbolVal (Proxy @pfx) <>) . encodeString @(DeriveTextEncode opt a)- decodeString = coerce $ decodeString @(DeriveTextEncode opt a) . dropPfx @pfx+instance (KnownSymbol pfx, TextEncode (ReadShowEncoding opt a)) => TextEncode (ReadShowEncoding (AddPrefix pfx opt) a) where+ encodeString = coerce $ (symbolVal (Proxy @pfx) <>) . encodeString @(ReadShowEncoding opt a)+ decodeString = coerce $ decodeString @(ReadShowEncoding opt a) . dropPfx @pfx - {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-} data Cased (decoding :: Casing) (encoding :: Casing) (opt :: Type) -instance (CaseConversion d e, TextEncode (DeriveTextEncode opt a)) => TextEncode (DeriveTextEncode (Cased d e opt) a) where- encodeString = coerce $ encoding @d @e . encodeString @(DeriveTextEncode opt a)- decodeString = coerce $ decodeString @(DeriveTextEncode opt a) . decoding @d @e+instance (CaseConversion d e, TextEncode (ReadShowEncoding opt a)) => TextEncode (ReadShowEncoding (Cased d e opt) a) where+ encodeString = coerce $ encoding @d @e . encodeString @(ReadShowEncoding opt a)+ decodeString = coerce $ decodeString @(ReadShowEncoding opt a) . decoding @d @e - {-# INLINE encodeString #-}- {-# INLINE decodeString #-}+ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-} +{- | Derive 'TextEncode' using 'Bounded' and 'Enum'.++@+ data MyType = MyTypeFoo | MyTypeBar | MyTypeFooBar+ deriving stock (Bounded, Enum)+ deriving TextEncode BoundedEnumEncoding+@+-}+newtype BoundedEnumEncoding a = BoundedEnumEncoding a+ deriving (Bounded, Enum) via a++instance (Bounded a, Enum a, Typeable a) => TextEncode (BoundedEnumEncoding a) where+ encodeString = show . fromEnum+ decodeString = coerce $ maybeDecode @a $ toEnumMaybe <=< readMaybe++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}++{- | Define @'ByteStringPrimitives' A@ to derive @'TextEncode' A@ in terms of+'ByteString' primitives. This is often more efficient than using the default+'TextEncode' instance methods, which use 'String' as an intermediate+representation.++@+ newtype MyType = ...++ instance ByteStringPrimitives MyType where ...++ deriving via ByteStringEncoding MyType instance TextEncode MyType+@+-}+newtype ByteStringEncoding a = ByteStringEncoding a+ deriving (ByteStringPrimitives) via a++class ByteStringPrimitives a where+ byteStringEncode :: a -> ByteString+ byteStringDecode :: ByteString -> Either String a++instance (ByteStringPrimitives a) => TextEncode (ByteStringEncoding a) where+ encodeString = coerce $ asString . byteStringEncode @a+ decodeString = coerce $ byteStringDecode @a . asByteString @String++ encodeByteString = coerce $ byteStringEncode @a+ decodeByteString = coerce $ byteStringDecode @a++ encodeLazyByteString = coerce $ asLazyByteString . byteStringEncode @a+ decodeLazyByteString = coerce $ byteStringDecode @a . asByteString @LazyByteString++ encodeText = coerce $ asText . byteStringEncode @a+ decodeText = coerce $ byteStringDecode @a . asByteString @Text++ encodeLazyText = coerce $ asLazyText . byteStringEncode @a+ decodeLazyText = coerce $ byteStringDecode @a . asByteString @LazyText++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}+ {-# INLINE encodeByteString #-}+ {-# INLINE decodeByteString #-}+ {-# INLINE encodeLazyByteString #-}+ {-# INLINE decodeLazyByteString #-}+ {-# INLINE encodeText #-}+ {-# INLINE decodeText #-}+ {-# INLINE encodeLazyText #-}+ {-# INLINE decodeLazyText #-}++{- | Define @'LazyByteStringPrimitives' A@ to derive @'TextEncode' A@ in terms+of 'LazyByteString' primitives. This is often more efficient than using the+default 'TextEncode' instance methods, which use 'String' as an intermediate+representation.++@+ newtype MyType = ...++ instance LazyByteStringPrimitives MyType where ...++ deriving via LazyByteStringEncoding MyType instance TextEncode MyType+@+-}+newtype LazyByteStringEncoding a = LazyByteStringEncoding a++class LazyByteStringPrimitives a where+ lazyByteStringEncode :: a -> LazyByteString+ lazyByteStringDecode :: LazyByteString -> Either String a++instance (LazyByteStringPrimitives a) => TextEncode (LazyByteStringEncoding a) where+ encodeString = coerce $ asString . lazyByteStringEncode @a+ decodeString = coerce $ lazyByteStringDecode @a . asLazyByteString @String++ encodeByteString = coerce $ asByteString . lazyByteStringEncode @a+ decodeByteString = coerce $ lazyByteStringDecode @a . asLazyByteString @ByteString++ encodeLazyByteString = coerce $ lazyByteStringEncode @a+ decodeLazyByteString = coerce $ lazyByteStringDecode @a++ encodeText = coerce $ asText . lazyByteStringEncode @a+ decodeText = coerce $ lazyByteStringDecode @a . asLazyByteString @Text++ encodeLazyText = coerce $ asLazyText . lazyByteStringEncode @a+ decodeLazyText = coerce $ lazyByteStringDecode @a . asLazyByteString @LazyText++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}+ {-# INLINE encodeByteString #-}+ {-# INLINE decodeByteString #-}+ {-# INLINE encodeLazyByteString #-}+ {-# INLINE decodeLazyByteString #-}+ {-# INLINE encodeText #-}+ {-# INLINE decodeText #-}+ {-# INLINE encodeLazyText #-}+ {-# INLINE decodeLazyText #-}++{- | Define @'TextPrimitives' A@ to derive @'TextEncode' A@ in terms of+'Text' primitives. This is often more efficient than using the default+'TextEncode' instance methods, which use 'String' as an intermediate+representation.++@+ newtype MyType = ...++ instance TextPrimitives MyType where ...++ deriving via TextEncoding MyType instance TextEncode MyType+@+-}+newtype TextEncoding a = TextEncoding a+ deriving (TextPrimitives) via a++class TextPrimitives a where+ textEncode :: a -> Text+ textDecode :: Text -> Either String a++instance (TextPrimitives a) => TextEncode (TextEncoding a) where+ encodeString = coerce $ asString . textEncode @a+ decodeString = coerce $ textDecode @a . asText @String++ encodeByteString = coerce $ asByteString . textEncode @a+ decodeByteString = coerce $ textDecode @a . asText @ByteString++ encodeLazyByteString = coerce $ asLazyByteString . textEncode @a+ decodeLazyByteString = coerce $ textDecode @a . asText @LazyByteString++ encodeText = coerce $ textEncode @a+ decodeText = coerce $ textDecode @a++ encodeLazyText = coerce $ asLazyText . textEncode @a+ decodeLazyText = coerce $ textDecode @a . asText @LazyText++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}+ {-# INLINE encodeByteString #-}+ {-# INLINE decodeByteString #-}+ {-# INLINE encodeLazyByteString #-}+ {-# INLINE decodeLazyByteString #-}+ {-# INLINE encodeText #-}+ {-# INLINE decodeText #-}+ {-# INLINE encodeLazyText #-}+ {-# INLINE decodeLazyText #-}++{- | Define @'LazyTextPrimitives' A@ to derive @'TextEncode' A@ in terms of+'LazyText' primitives. This is often more efficient than using the default+'TextEncode' instance methods, which use 'String' as an intermediate+representation.++@+ newtype MyType = ...++ instance LazyTextPrimitives MyType where ...++ deriving via LazyTextEncoding MyType instance TextEncode MyType+@+-}+newtype LazyTextEncoding a = LazyTextEncoding a+ deriving (LazyTextPrimitives) via a++class LazyTextPrimitives a where+ lazyTextEncode :: a -> LazyText+ lazyTextDecode :: LazyText -> Either String a++instance (LazyTextPrimitives a) => TextEncode (LazyTextEncoding a) where+ encodeString = coerce $ asString . lazyTextEncode @a+ decodeString = coerce $ lazyTextDecode @a . asLazyText @String++ encodeByteString = coerce $ asByteString . lazyTextEncode @a+ decodeByteString = coerce $ lazyTextDecode @a . asLazyText @ByteString++ encodeLazyByteString = coerce $ asLazyByteString . lazyTextEncode @a+ decodeLazyByteString = coerce $ lazyTextDecode @a . asLazyText @LazyByteString++ encodeText = coerce $ asText . lazyTextEncode @a+ decodeText = coerce $ lazyTextDecode @a . asLazyText @Text++ encodeLazyText = coerce $ asLazyText . lazyTextEncode @a+ decodeLazyText = coerce $ lazyTextDecode @a . asLazyText @LazyText++ {-# INLINE encodeString #-}+ {-# INLINE decodeString #-}+ {-# INLINE encodeByteString #-}+ {-# INLINE decodeByteString #-}+ {-# INLINE encodeLazyByteString #-}+ {-# INLINE decodeLazyByteString #-}+ {-# INLINE encodeText #-}+ {-# INLINE decodeText #-}+ {-# INLINE encodeLazyText #-}+ {-# INLINE decodeLazyText #-}+ type FunctionName = String type Message = String type Input a = a@@ -171,16 +457,16 @@ typedError :: forall a b. (Typeable a, Show b) => FunctionName -> Message -> Input b -> String typedError fn msg input = mconcat [fn, " @", show (typeRep $ Proxy @a), ": ", msg, show input] -decodeError :: forall a b. Typeable a => Input String -> Either String b+decodeError :: forall a b. (Typeable a) => Input String -> Either String b decodeError input = Left $ typedError @a "decode" "Failed to decode " input -maybeDecode :: forall a. Typeable a => (String -> Maybe a) -> Input String -> Either String a+maybeDecode :: forall a. (Typeable a) => (String -> Maybe a) -> Input String -> Either String a maybeDecode f raw = maybe (decodeError @a raw) Right $ f raw toEnumMaybe :: forall a. (Bounded a, Enum a) => Int -> Maybe a toEnumMaybe n = toEnum n <$ guard (fromEnum (minBound @a) <= n && n <= fromEnum (maxBound @a)) -dropPfx :: forall pfx. KnownSymbol pfx => String -> String+dropPfx :: forall pfx. (KnownSymbol pfx) => String -> String dropPfx = drop $ length $ symbolVal $ Proxy @pfx {-# INLINE typedError #-}
src/text-encode/Text/Encode/Casing.hs view
@@ -1,270 +1,269 @@ module Text.Encode.Casing (- Casing(..),- CaseConversion(..),+ Casing (..),+ CaseConversion (..), ) where import Text.Casing qualified as C data Casing- = Camel- | Kebab- | Pascal- | QuietSnake- | ScreamingSnake- | Snake+ = Camel+ | Kebab+ | Pascal+ | QuietSnake+ | ScreamingSnake+ | Snake class CaseConversion (decoding :: Casing) (encoding :: Casing) where- encoding :: String -> String- decoding :: String -> String+ encoding :: String -> String+ decoding :: String -> String instance CaseConversion 'Camel 'Camel where- encoding = id- decoding = id+ encoding = id+ decoding = id - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Camel 'Kebab where- encoding = C.toKebab . C.fromHumps- decoding = C.toCamel . C.fromKebab+ encoding = C.toKebab . C.fromHumps+ decoding = C.toCamel . C.fromKebab - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Camel 'Pascal where- encoding = C.toPascal . C.fromHumps- decoding = C.toCamel . C.fromHumps+ encoding = C.toPascal . C.fromHumps+ decoding = C.toCamel . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Camel 'QuietSnake where- encoding = C.toQuietSnake . C.fromHumps- decoding = C.toCamel . C.fromSnake+ encoding = C.toQuietSnake . C.fromHumps+ decoding = C.toCamel . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Camel 'ScreamingSnake where- encoding = C.toScreamingSnake . C.fromHumps- decoding = C.toCamel . C.fromSnake+ encoding = C.toScreamingSnake . C.fromHumps+ decoding = C.toCamel . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Camel 'Snake where- encoding = C.toSnake . C.fromHumps- decoding = C.toCamel . C.fromSnake+ encoding = C.toSnake . C.fromHumps+ decoding = C.toCamel . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'Camel where- encoding = C.toCamel . C.fromKebab- decoding = C.toKebab . C.fromHumps+ encoding = C.toCamel . C.fromKebab+ decoding = C.toKebab . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'Kebab where- encoding = id- decoding = id+ encoding = id+ decoding = id - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'Pascal where- encoding = C.toPascal . C.fromKebab- decoding = C.toKebab . C.fromHumps+ encoding = C.toPascal . C.fromKebab+ decoding = C.toKebab . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'QuietSnake where- encoding = C.toQuietSnake . C.fromKebab- decoding = C.toKebab . C.fromSnake+ encoding = C.toQuietSnake . C.fromKebab+ decoding = C.toKebab . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'ScreamingSnake where- encoding = C.toScreamingSnake . C.fromKebab- decoding = C.toKebab . C.fromSnake+ encoding = C.toScreamingSnake . C.fromKebab+ decoding = C.toKebab . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Kebab 'Snake where- encoding = C.toSnake . C.fromKebab- decoding = C.toKebab . C.fromSnake+ encoding = C.toSnake . C.fromKebab+ decoding = C.toKebab . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'Camel where- encoding = C.toCamel . C.fromHumps- decoding = C.toPascal . C.fromHumps+ encoding = C.toCamel . C.fromHumps+ decoding = C.toPascal . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'Kebab where- encoding = C.toKebab . C.fromHumps- decoding = C.toPascal . C.fromKebab+ encoding = C.toKebab . C.fromHumps+ decoding = C.toPascal . C.fromKebab - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'Pascal where- encoding = id- decoding = id+ encoding = id+ decoding = id - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'QuietSnake where- encoding = C.toQuietSnake . C.fromHumps- decoding = C.toPascal . C.fromSnake+ encoding = C.toQuietSnake . C.fromHumps+ decoding = C.toPascal . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'ScreamingSnake where- encoding = C.toScreamingSnake . C.fromHumps- decoding = C.toPascal . C.fromSnake+ encoding = C.toScreamingSnake . C.fromHumps+ decoding = C.toPascal . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Pascal 'Snake where- encoding = C.toSnake . C.fromHumps- decoding = C.toPascal . C.fromSnake+ encoding = C.toSnake . C.fromHumps+ decoding = C.toPascal . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'Camel where- encoding = C.toCamel . C.fromSnake- decoding = C.toQuietSnake . C.fromHumps+ encoding = C.toCamel . C.fromSnake+ decoding = C.toQuietSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'Kebab where- encoding = C.toKebab . C.fromSnake- decoding = C.toQuietSnake . C.fromKebab+ encoding = C.toKebab . C.fromSnake+ decoding = C.toQuietSnake . C.fromKebab - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'Pascal where- encoding = C.toPascal . C.fromSnake- decoding = C.toQuietSnake . C.fromHumps+ encoding = C.toPascal . C.fromSnake+ decoding = C.toQuietSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'QuietSnake where- encoding = id- decoding = id+ encoding = id+ decoding = id - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'ScreamingSnake where- encoding = C.toScreamingSnake . C.fromSnake- decoding = C.toQuietSnake . C.fromSnake+ encoding = C.toScreamingSnake . C.fromSnake+ decoding = C.toQuietSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'QuietSnake 'Snake where- encoding = C.toSnake . C.fromSnake- decoding = C.toQuietSnake . C.fromSnake+ encoding = C.toSnake . C.fromSnake+ decoding = C.toQuietSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'Camel where- encoding = C.toCamel . C.fromSnake- decoding = C.toScreamingSnake . C.fromHumps+ encoding = C.toCamel . C.fromSnake+ decoding = C.toScreamingSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'Kebab where- encoding = C.toKebab . C.fromSnake- decoding = C.toScreamingSnake . C.fromKebab+ encoding = C.toKebab . C.fromSnake+ decoding = C.toScreamingSnake . C.fromKebab - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'Pascal where- encoding = C.toPascal . C.fromSnake- decoding = C.toScreamingSnake . C.fromHumps+ encoding = C.toPascal . C.fromSnake+ decoding = C.toScreamingSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'QuietSnake where- encoding = C.toQuietSnake . C.fromSnake- decoding = C.toScreamingSnake . C.fromSnake+ encoding = C.toQuietSnake . C.fromSnake+ decoding = C.toScreamingSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'ScreamingSnake where- encoding = id- decoding = id+ encoding = id+ decoding = id - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'ScreamingSnake 'Snake where- encoding = C.toSnake . C.fromSnake- decoding = C.toScreamingSnake . C.fromSnake+ encoding = C.toSnake . C.fromSnake+ decoding = C.toScreamingSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'Camel where- encoding = C.toCamel . C.fromSnake- decoding = C.toSnake . C.fromHumps+ encoding = C.toCamel . C.fromSnake+ decoding = C.toSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'Kebab where- encoding = C.toKebab . C.fromSnake- decoding = C.toSnake . C.fromKebab+ encoding = C.toKebab . C.fromSnake+ decoding = C.toSnake . C.fromKebab - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'Pascal where- encoding = C.toPascal . C.fromSnake- decoding = C.toSnake . C.fromHumps+ encoding = C.toPascal . C.fromSnake+ decoding = C.toSnake . C.fromHumps - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'QuietSnake where- encoding = C.toQuietSnake . C.fromSnake- decoding = C.toSnake . C.fromSnake+ encoding = C.toQuietSnake . C.fromSnake+ decoding = C.toSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'ScreamingSnake where- encoding = C.toScreamingSnake . C.fromSnake- decoding = C.toSnake . C.fromSnake+ encoding = C.toScreamingSnake . C.fromSnake+ decoding = C.toSnake . C.fromSnake - {-# INLINE encoding #-}- {-# INLINE decoding #-}+ {-# INLINE encoding #-}+ {-# INLINE decoding #-} instance CaseConversion 'Snake 'Snake where- encoding = id- decoding = id-- {-# INLINE decoding #-}- {-# INLINE encoding #-}+ encoding = id+ decoding = id+ {-# INLINE decoding #-}+ {-# INLINE encoding #-}
text-encode.cabal view
@@ -1,14 +1,6 @@ cabal-version: 3.0 name: text-encode-version: 0.1.0.0-homepage: https://github.com/friedbrice/text-encode#readme-bug-reports: https://github.com/friedbrice/text-encode/issues-author: Daniel Brice-maintainer: danielbrice@gmail.com-copyright: Copyright Daniel Brice-license: BSD-3-Clause-license-file: LICENSE-build-type: Simple+version: 0.2.0.0 category: Serialization synopsis: Classes and newtypes for deriving uniform textual encodings.@@ -17,7 +9,15 @@ Classes and newtypes for deriving uniform textual encodings. See the Text.Encode module documentation for details and usage examples. +homepage: https://github.com/friedbrice/text-encode#readme+bug-reports: https://github.com/friedbrice/text-encode/issues+author: Daniel Brice+maintainer: danielbrice@gmail.com+copyright: Copyright Daniel Brice+license: BSD-3-Clause+license-file: LICENSE extra-source-files: README.md+build-type: Simple tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.2 @@ -39,6 +39,7 @@ KindSignatures MultiParamTypeClasses ScopedTypeVariables+ StandaloneDeriving TupleSections TypeApplications UndecidableInstances@@ -57,18 +58,21 @@ , bytestring >=0.11 && <0.13 , casing >=0.1 && <0.2 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-aeson build-depends: , aeson >=2.0 && <2.3 , bytestring >=0.11 && <0.13 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-cassava build-depends: , bytestring >=0.11 && <0.13 , cassava >=0.5 && <0.6 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-http-api-data build-depends:@@ -76,21 +80,25 @@ , http-api-data >=0.4 && <0.7 , http-types >=0.12 && <0.13 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-persistent build-depends: , persistent >=2.13 && <2.18 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-postgresql-simple build-depends: , postgresql-simple >=0.6 && <0.8 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-sqlite-simple build-depends: , sqlite-simple >=0.4 && <0.5 , text >=1.2 && <2.2+ , text-convert >=0.1 && <0.2 common deps-dev