diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for base64-lens +## 0.1.1.0 + +* Add Short and Lazy optics modules for Text and ByteString +* Add Trustworthy pragmas +* Remove doctesting target in favor of `cabal-docspec` +* Migrate to Github CI +* Test on GHC 8.10 + ## 0.1.0.0 * First version. Released on an unsuspecting world. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,41 +4,3 @@ [![Hackage](https://img.shields.io/hackage/v/base32-lens.svg)](https://hackage.haskell.org/package/base32-lens) This package provides optics and convenient pattern synonyms for the [base32](https://hackage.haskell.org/package/base32) library. - -### Patterns - -The pattern synonyms provided in this library are: - -```haskell -pattern Base32 :: ByteString -> ByteString -pattern Base32Url :: ByteString -> ByteString -pattern Base32UrlUnpadded :: ByteString -> ByteString - --- and - -pattern Base32 :: Text -> Text -pattern Base32Url :: Text -> Text -pattern Base32UrlUnpadded :: Text -> Text -``` - -These provide a convenient high level interface for passing Base32 encoded values. - - -### Optics - -`Prism`s for encoding and decoding `Text` and `ByteString` values are given as part of the library: - - -```haskell -_Base32 :: Prism' ByteString ByteString -_Base32Url :: Prism' ByteString ByteString -_Base32UrlUnpadded :: Prism' ByteString ByteString - --- and - -_Base32 :: Prism' Text Text -_Base32Url :: Prism' Text Text -_Base32UrlUnpadded :: Prism' Text Text -``` - -If a particular structure has a `Lens` into some `Text` or `ByteString` value they might want to encode (or decode), then composing such a `Lens` with these `Prisms` yields an affine `Traversal`, resulting in a structure which has the focus of its `Lens` encoded as or decoded from Base32(-url). diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,6 +1,2 @@ -module Main where - -import Distribution.Extra.Doctest (defaultMainWithDoctests) - -main :: IO () -main = defaultMainWithDoctests "doctests" +import Distribution.Simple +main = defaultMain diff --git a/base32-lens.cabal b/base32-lens.cabal --- a/base32-lens.cabal +++ b/base32-lens.cabal @@ -1,62 +1,47 @@ -cabal-version: 1.24 - -name: base32-lens -version: 0.1.0.0 -synopsis: Optics for the Base32 library -description: - Prisms and pattern synonyms for the Base32 library -homepage: https://github.com/emilypi/base32-lens -bug-reports: https://github.com/emilypi/base32-lens/issues -license: BSD3 -license-file: LICENSE -author: Emily Pillmore -maintainer: emilypi@cohomolo.gy -copyright: (c) 2020 Emily Pillmore -category: Data -build-type: Custom +cabal-version: 2.0 +name: base32-lens +version: 0.1.1.0 +synopsis: Optics for the Base32 library +description: Prisms and pattern synonyms for the Base32 library +homepage: https://github.com/emilypi/base32-lens +bug-reports: https://github.com/emilypi/base32-lens/issues +license: BSD3 +license-file: LICENSE +author: Emily Pillmore +maintainer: emilypi@cohomolo.gy +copyright: (c) 2020 Emily Pillmore +category: Data +build-type: Simple extra-source-files: CHANGELOG.md README.md -tested-with: GHC ==8.8.1 || ==8.6.5 || ==8.6.3 || ==8.4.4 || ==8.4.3 || ==8.2.2 +tested-with: + GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 source-repository head type: git - location: https://github.com/emilypi/base32.git - - -custom-setup - setup-depends: - base >=4.10 && <5 - , Cabal - , cabal-doctest + location: https://github.com/emilypi/base32-lens.git library - exposed-modules: Data.ByteString.Base32.Lens - , Data.Text.Encoding.Base32.Lens - - build-depends: base >=4.10 && <5 - , base32 >=0.1 && <0.2 - , bytestring >=0.10 && <0.11 - , lens >=4.0 && <5 - , text >=1.2 && <1.3 - - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall - - -test-suite doctests - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: doctests.hs + exposed-modules: + Data.ByteString.Base32.Lens + Data.ByteString.Lazy.Base32.Lens + Data.ByteString.Short.Base32.Lens + Data.Text.Encoding.Base32.Lens + Data.Text.Encoding.Base32.Error.Lens + Data.Text.Lazy.Encoding.Base32.Lens + Data.Text.Short.Encoding.Base32.Lens - build-depends: base >=4.10 && <5 - , base32-lens - , doctest - , lens + build-depends: + base >=4.10 && <5 + , base32 ^>=0.2 + , bytestring ^>=0.10 + , lens >=4.0 && <5.1 + , text ^>=1.2 + , text-short ^>=0.1 - hs-source-dirs: test - ghc-options: -Wall -threaded - x-doctest-options: --fast + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Data/ByteString/Base32/Lens.hs b/src/Data/ByteString/Base32/Lens.hs --- a/src/Data/ByteString/Base32/Lens.hs +++ b/src/Data/ByteString/Base32/Lens.hs @@ -1,7 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif -- | --- Module : Data.Text.Encoding.Base32.Lens +-- Module : Data.ByteString.Base32.Lens -- Copyright : (c) 2019 Emily Pillmore -- License : BSD-style -- diff --git a/src/Data/ByteString/Lazy/Base32/Lens.hs b/src/Data/ByteString/Lazy/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lazy/Base32/Lens.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE Trustworthy #-} +-- | +-- Module : Data.ByteString.Lazy.Base32.Lens +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Prism''s for Base32-encoding and +-- decoding 'ByteString' values. +-- +module Data.ByteString.Lazy.Base32.Lens +( -- * Prisms + _Base32 +, _Base32Unpadded +, _Base32Hex +, _Base32HexUnpadded +-- , _Base32Lenient +-- , _Base32HexLenient + -- * Patterns +, pattern Base32 +, pattern Base32Unpadded +, pattern Base32Hex +, pattern Base32HexUnpadded +-- , pattern Base32Lenient +-- , pattern Base32HexLenient +) where + + +import Control.Lens + +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy.Base32 as LB32 +import qualified Data.ByteString.Lazy.Base32.Hex as LB32H + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.ByteString.Lazy.Base32.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Prism'' into the Base32 encoding of a 'ByteString' value +-- +-- >>> _Base32 # "Sun" +-- "KN2W4===" +-- +-- >>> "KN2W4===" ^? _Base32 +-- Just "Sun" +-- +_Base32 :: Prism' ByteString ByteString +_Base32 = prism' LB32.encodeBase32' $ \s -> case LB32.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32 #-} + +-- | A 'Prism'' into the Base32 encoding of a 'ByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32Unpadded # "Sun" +-- "KN2W4" +-- +-- >>> "KN2W4" ^? _Base32Unpadded +-- Just "Sun" +-- +_Base32Unpadded :: Prism' ByteString ByteString +_Base32Unpadded = prism' LB32.encodeBase32Unpadded' $ \s -> case LB32.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Unpadded #-} + +-- | A 'Prism'' into the Base32hex encoding of a 'ByteString' value +-- +-- >>> _Base32Hex # "Sun" +-- "ADQMS===" +-- +-- >>> "ADQMS===" ^? _Base32Hex +-- Just "Sun" +-- +_Base32Hex :: Prism' ByteString ByteString +_Base32Hex = prism' LB32H.encodeBase32' $ \s -> case LB32H.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Hex #-} + +-- | A 'Prism'' into the Base32hex encoding of a 'ByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32HexUnpadded # "Sun" +-- "ADQMS" +-- +-- >>> "ADQMS" ^? _Base32HexUnpadded +-- Just "Sun" +-- +_Base32HexUnpadded :: Prism' ByteString ByteString +_Base32HexUnpadded = prism' LB32H.encodeBase32Unpadded' $ \s -> case LB32H.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32HexUnpadded #-} + +-- -- | An 'Iso'' into the Base32 encoding of a 'ByteString' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "Sun" ^. _Base32Lenient +-- -- "U3Vu" +-- -- +-- -- >>> "U3Vu" ^. from _Base32Lenient +-- -- "Sun" +-- -- +-- _Base32Lenient :: Iso' ByteString ByteString +-- _Base32Lenient = iso LB32.encodeBase32' LB32.decodeBase32Lenient + +-- -- | An 'Iso'' into the Base32hex encoding of a 'ByteString' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "<>" ^. _Base32HexLenient +-- -- "PDw_Pz4-" +-- -- +-- -- >>> "PDw_Pz4-" ^. from _Base32HexLenient +-- -- "<>" +-- -- +-- _Base32HexLenient :: Iso' ByteString ByteString +-- _Base32HexLenient = iso LB32H.encodeBase32' LB32H.decodeBase32Lenient + +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Bidirectional pattern synonym for Base32-encoded 'ByteString' values. +-- +pattern Base32 :: ByteString -> ByteString +pattern Base32 a <- (preview _Base32 -> Just a) where + Base32 a = _Base32 # a + +-- | Bidirectional pattern synonym for unpadded Base32-encoded 'ByteString' values. +-- +pattern Base32Unpadded :: ByteString -> ByteString +pattern Base32Unpadded a <- (preview _Base32Unpadded -> Just a) where + Base32Unpadded a = _Base32Unpadded # a + +-- | Bidirectional pattern synonym for Base32hex-encoded 'ByteString' values. +-- +pattern Base32Hex :: ByteString -> ByteString +pattern Base32Hex a <- (preview _Base32Hex -> Just a) where + Base32Hex a = _Base32Hex # a + +-- | Bidirectional pattern synonym for unpadded Base32hex-encoded 'ByteString' values. +-- +pattern Base32HexUnpadded :: ByteString -> ByteString +pattern Base32HexUnpadded a <- (preview _Base32HexUnpadded -> Just a) where + Base32HexUnpadded a = _Base32HexUnpadded # a + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ByteString' values +-- -- +-- pattern Base32Lenient :: ByteString -> ByteString +-- pattern Base32Lenient a <- (view (from _Base32Lenient) -> a) where +-- Base32Lenient a = view _Base32Lenient a +-- {-# COMPLETE Base32Lenient #-} + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ByteString' values +-- -- +-- pattern Base32HexLenient :: ByteString -> ByteString +-- pattern Base32HexLenient a <- (view (from _Base32HexLenient) -> a) where +-- Base32HexLenient a = view _Base32HexLenient a +-- {-# COMPLETE Base32HexLenient #-} diff --git a/src/Data/ByteString/Short/Base32/Lens.hs b/src/Data/ByteString/Short/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Short/Base32/Lens.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.ByteString.Short.Base32.Lens +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Prism''s for Base32-encoding and +-- decoding 'ShortByteString' values. +-- +module Data.ByteString.Short.Base32.Lens +( -- * Prisms + _Base32 +, _Base32Unpadded +, _Base32Hex +, _Base32HexUnpadded +-- , _Base32Lenient +-- , _Base32HexLenient + -- * Patterns +, pattern Base32 +, pattern Base32Unpadded +, pattern Base32Hex +, pattern Base32HexUnpadded +-- , pattern Base32Lenient +-- , pattern Base32HexLenient +) where + + +import Control.Lens + +import Data.ByteString.Short (ShortByteString) +import qualified Data.ByteString.Short.Base32 as SB32 +import qualified Data.ByteString.Short.Base32.Hex as SB32H + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.ByteString.Short.Base32.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Prism'' into the Base32 encoding of a 'ShortByteString' value +-- +-- >>> _Base32 # "Sun" +-- "KN2W4===" +-- +-- >>> "KN2W4===" ^? _Base32 +-- Just "Sun" +-- +_Base32 :: Prism' ShortByteString ShortByteString +_Base32 = prism' SB32.encodeBase32' $ \s -> case SB32.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32 #-} + +-- | A 'Prism'' into the Base32 encoding of a 'ShortByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32Unpadded # "Sun" +-- "KN2W4" +-- +-- >>> "KN2W4" ^? _Base32Unpadded +-- Just "Sun" +-- +_Base32Unpadded :: Prism' ShortByteString ShortByteString +_Base32Unpadded = prism' SB32.encodeBase32Unpadded' $ \s -> case SB32.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Unpadded #-} + +-- | A 'Prism'' into the Base32hex encoding of a 'ShortByteString' value +-- +-- >>> _Base32Hex # "Sun" +-- "ADQMS===" +-- +-- >>> "ADQMS===" ^? _Base32Hex +-- Just "Sun" +-- +_Base32Hex :: Prism' ShortByteString ShortByteString +_Base32Hex = prism' SB32H.encodeBase32' $ \s -> case SB32H.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Hex #-} + +-- | A 'Prism'' into the Base32hex encoding of a 'ShortByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32HexUnpadded # "Sun" +-- "ADQMS" +-- +-- >>> "ADQMS" ^? _Base32HexUnpadded +-- Just "Sun" +-- +_Base32HexUnpadded :: Prism' ShortByteString ShortByteString +_Base32HexUnpadded = prism' SB32H.encodeBase32Unpadded' $ \s -> case SB32H.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32HexUnpadded #-} + +-- -- | An 'Iso'' into the Base32 encoding of a 'ShortByteString' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "Sun" ^. _Base32Lenient +-- -- "U3Vu" +-- -- +-- -- >>> "U3Vu" ^. from _Base32Lenient +-- -- "Sun" +-- -- +-- _Base32Lenient :: Iso' ShortByteString ShortByteString +-- _Base32Lenient = iso SB32.encodeBase32' SB32.decodeBase32Lenient + +-- -- | An 'Iso'' into the Base32hex encoding of a 'ShortByteString' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "<>" ^. _Base32HexLenient +-- -- "PDw_Pz4-" +-- -- +-- -- >>> "PDw_Pz4-" ^. from _Base32HexLenient +-- -- "<>" +-- -- +-- _Base32HexLenient :: Iso' ShortByteString ShortByteString +-- _Base32HexLenient = iso SB32H.encodeBase32' SB32H.decodeBase32Lenient + +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Bidirectional pattern synonym for Base32-encoded 'ShortByteString' values. +-- +pattern Base32 :: ShortByteString -> ShortByteString +pattern Base32 a <- (preview _Base32 -> Just a) where + Base32 a = _Base32 # a + +-- | Bidirectional pattern synonym for unpadded Base32-encoded 'ShortByteString' values. +-- +pattern Base32Unpadded :: ShortByteString -> ShortByteString +pattern Base32Unpadded a <- (preview _Base32Unpadded -> Just a) where + Base32Unpadded a = _Base32Unpadded # a + +-- | Bidirectional pattern synonym for Base32hex-encoded 'ShortByteString' values. +-- +pattern Base32Hex :: ShortByteString -> ShortByteString +pattern Base32Hex a <- (preview _Base32Hex -> Just a) where + Base32Hex a = _Base32Hex # a + +-- | Bidirectional pattern synonym for unpadded Base32hex-encoded 'ShortByteString' values. +-- +pattern Base32HexUnpadded :: ShortByteString -> ShortByteString +pattern Base32HexUnpadded a <- (preview _Base32HexUnpadded -> Just a) where + Base32HexUnpadded a = _Base32HexUnpadded # a + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ShortByteString' values +-- -- +-- pattern Base32Lenient :: ShortByteString -> ShortByteString +-- pattern Base32Lenient a <- (view (from _Base32Lenient) -> a) where +-- Base32Lenient a = view _Base32Lenient a +-- {-# COMPLETE Base32Lenient #-} + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ShortByteString' values +-- -- +-- pattern Base32HexLenient :: ShortByteString -> ShortByteString +-- pattern Base32HexLenient a <- (view (from _Base32HexLenient) -> a) where +-- Base32HexLenient a = view _Base32HexLenient a +-- {-# COMPLETE Base32HexLenient #-} diff --git a/src/Data/Text/Encoding/Base32/Error/Lens.hs b/src/Data/Text/Encoding/Base32/Error/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Encoding/Base32/Error/Lens.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Text.Encoding.Base32.Error.Lens +-- Copyright : (c) 2019-2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Prism''s for the `Data.Text.Encoding.Base32.Error.Base32Error` +-- datatype. +-- +module Data.Text.Encoding.Base32.Error.Lens +( -- * Prisms + _DecodeError +, _ConversionError +) where + + +import Control.Lens + +import Data.Text (Text) +import Data.Text.Encoding.Base32.Error (Base32Error(..)) + + +-- | A 'Prism'' into the 'DecodeError' case of a 'Base32Error' +-- +_DecodeError :: Prism' (Base32Error err) Text +_DecodeError = prism' DecodeError $ \case + DecodeError t -> Just t + ConversionError{} -> Nothing + +-- | A 'Prism'' into the 'ConversionError' case of a 'Base32Error' +-- +_ConversionError :: Prism' (Base32Error err) err +_ConversionError = prism' ConversionError $ \case + ConversionError err -> Just err + DecodeError{} -> Nothing diff --git a/src/Data/Text/Encoding/Base32/Lens.hs b/src/Data/Text/Encoding/Base32/Lens.hs --- a/src/Data/Text/Encoding/Base32/Lens.hs +++ b/src/Data/Text/Encoding/Base32/Lens.hs @@ -1,5 +1,11 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif -- | -- Module : Data.Text.Encoding.Base32.Lens -- Copyright : (c) 2020 Emily Pillmore diff --git a/src/Data/Text/Lazy/Encoding/Base32/Lens.hs b/src/Data/Text/Lazy/Encoding/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Lazy/Encoding/Base32/Lens.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Text.Lazy.Encoding.Base32.Lens +-- Copyright : (c) 2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Prism's Base32-encoding and +-- decoding 'Text' values. +-- +module Data.Text.Lazy.Encoding.Base32.Lens +( -- * Prisms + _Base32 +, _Base32Unpadded +, _Base32Hex +, _Base32HexUnpadded +-- , _Base32Lenient +-- , _Base32HexLenient + -- * Patterns +, pattern Base32 +, pattern Base32Unpadded +, pattern Base32Hex +, pattern Base32HexUnpadded +-- , pattern Base32Lenient +-- , pattern Base32HexLenient +) where + +import Control.Lens + +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy.Encoding.Base32 as B32TL +import qualified Data.Text.Lazy.Encoding.Base32.Hex as B32TLH + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.Text.Lazy.Encoding.Base32.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Prism' into the Base32 encoding of a 'Text' value. +-- +-- >>> _Base32 # "Sun" +-- "KN2W4===" +-- +-- >>> "KN2W4===" ^? _Base32 +-- Just "Sun" +-- +_Base32 :: Prism' Text Text +_Base32 = prism' B32TL.encodeBase32 $ \s -> case B32TL.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32 #-} + +-- | A 'Prism' into the Base32 encoding of a 'Text' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32Unpadded # "Sun" +-- "KN2W4" +-- +-- >>> "KN2W4" ^? _Base32Unpadded +-- Just "Sun" +-- +_Base32Unpadded :: Prism' Text Text +_Base32Unpadded = prism' B32TL.encodeBase32Unpadded $ \s -> case B32TL.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Unpadded #-} + +-- | A 'Prism' into the Base32-hex encoding of a 'Text' value. +-- +-- >>> _Base32Hex # "Sun" +-- "ADQMS===" +-- +-- >>> "ADQMS===" ^? _Base32Hex +-- Just "Sun" +-- +_Base32Hex :: Prism' Text Text +_Base32Hex = prism' B32TLH.encodeBase32 $ \s -> case B32TLH.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Hex #-} + +-- | A 'Prism' into the Base32-hex encoding of a 'Text' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32HexUnpadded # "Sun" +-- "ADQMS" +-- +-- >>> "ADQMS" ^? _Base32HexUnpadded +-- Just "Sun" +-- +_Base32HexUnpadded :: Prism' Text Text +_Base32HexUnpadded = prism' B32TLH.encodeBase32Unpadded $ \s -> case B32TLH.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32HexUnpadded #-} + +-- -- | An 'Iso'' into the Base32 encoding of a 'Text' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "Sun" ^. _Base32Lenient +-- -- "U3Vu" +-- -- +-- -- >>> "U3Vu" ^. from _Base32Lenient +-- -- "Sun" +-- -- +-- _Base32Lenient :: Iso' Text Text +-- _Base32Lenient = iso B32TL.encodeBase32 B32TL.decodeBase32Lenient + +-- -- | An 'Iso'' into the Base32hex encoding of a 'Text' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "<>" ^. _Base32HexLenient +-- -- "PDw_Pz4-" +-- -- +-- -- >>> "PDw_Pz4-" ^. from _Base32HexLenient +-- -- "<>" +-- -- +-- _Base32HexLenient :: Iso' Text Text +-- _Base32HexLenient = iso B32TLH.encodeBase32 B32TLH.decodeBase32Lenient + +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Unidirectional pattern synonym for Base32-encoded 'Text' values. +-- +pattern Base32 :: Text -> Text +pattern Base32 a <- (preview _Base32 -> Just a) where + Base32 a = _Base32 # a + +-- | Unidirectional pattern synonym for unpadded Base32-encoded 'Text' values. +-- +pattern Base32Unpadded :: Text -> Text +pattern Base32Unpadded a <- (preview _Base32Unpadded -> Just a) where + Base32Unpadded a = _Base32Unpadded # a + +-- | Unidirectional pattern synonym for Base32hex-encoded 'Text' values. +-- +pattern Base32Hex :: Text -> Text +pattern Base32Hex a <- (preview _Base32Hex -> Just a) where + Base32Hex a = _Base32Hex # a + +-- | Unidirectional pattern synonym for unpadded Base32hex-encoded 'Text' values. +-- +pattern Base32HexUnpadded :: Text -> Text +pattern Base32HexUnpadded a <- (preview _Base32HexUnpadded -> Just a) where + Base32HexUnpadded a = _Base32HexUnpadded # a + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'Text' values +-- -- +-- pattern Base32Lenient :: Text -> Text +-- pattern Base32Lenient a <- (view (from _Base32Lenient) -> a) where +-- Base32Lenient a = view _Base32Lenient a +-- {-# COMPLETE Base32Lenient #-} + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'Text' values +-- -- +-- pattern Base32HexLenient :: Text -> Text +-- pattern Base32HexLenient a <- (view (from _Base32HexLenient) -> a) where +-- Base32HexLenient a = view _Base32HexLenient a +-- {-# COMPLETE Base32HexLenient #-} diff --git a/src/Data/Text/Short/Encoding/Base32/Lens.hs b/src/Data/Text/Short/Encoding/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Short/Encoding/Base32/Lens.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +#if MIN_VERSION_lens(5,0,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Text.Short.Encoding.Base32.Lens +-- Copyright : (c) 2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Prism's Base32-encoding and +-- decoding 'Text' values. +-- +module Data.Text.Short.Encoding.Base32.Lens +( -- * Prisms + _Base32 +, _Base32Unpadded +, _Base32Hex +, _Base32HexUnpadded +-- , _Base32Lenient +-- , _Base32HexLenient + -- * Patterns +, pattern Base32 +, pattern Base32Unpadded +, pattern Base32Hex +, pattern Base32HexUnpadded +-- , pattern Base32Lenient +-- , pattern Base32HexLenient +) where + +import Control.Lens + +import Data.Text.Short (ShortText) +import qualified Data.Text.Short.Encoding.Base32 as B32TS +import qualified Data.Text.Short.Encoding.Base32.Hex as B32TSH + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.Text.Short.Encoding.Base32.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Prism' into the Base32 encoding of a 'ShortText' value. +-- +-- >>> _Base32 # "Sun" +-- "KN2W4===" +-- +-- >>> "KN2W4===" ^? _Base32 +-- Just "Sun" +-- +_Base32 :: Prism' ShortText ShortText +_Base32 = prism' B32TS.encodeBase32 $ \s -> case B32TS.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32 #-} + +-- | A 'Prism' into the Base32 encoding of a 'ShortText' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32Unpadded # "Sun" +-- "KN2W4" +-- +-- >>> "KN2W4" ^? _Base32Unpadded +-- Just "Sun" +-- +_Base32Unpadded :: Prism' ShortText ShortText +_Base32Unpadded = prism' B32TS.encodeBase32Unpadded $ \s -> case B32TS.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Unpadded #-} + +-- | A 'Prism' into the Base32-hex encoding of a 'ShortText' value. +-- +-- >>> _Base32Hex # "Sun" +-- "ADQMS===" +-- +-- >>> "ADQMS===" ^? _Base32Hex +-- Just "Sun" +-- +_Base32Hex :: Prism' ShortText ShortText +_Base32Hex = prism' B32TSH.encodeBase32 $ \s -> case B32TSH.decodeBase32 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32Hex #-} + +-- | A 'Prism' into the Base32-hex encoding of a 'ShortText' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base32HexUnpadded # "Sun" +-- "ADQMS" +-- +-- >>> "ADQMS" ^? _Base32HexUnpadded +-- Just "Sun" +-- +_Base32HexUnpadded :: Prism' ShortText ShortText +_Base32HexUnpadded = prism' B32TSH.encodeBase32Unpadded $ \s -> case B32TSH.decodeBase32Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base32HexUnpadded #-} + +-- -- | An 'Iso'' into the Base32 encoding of a 'ShortText' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "Sun" ^. _Base32Lenient +-- -- "U3Vu" +-- -- +-- -- >>> "U3Vu" ^. from _Base32Lenient +-- -- "Sun" +-- -- +-- _Base32Lenient :: Iso' ShortText ShortText +-- _Base32Lenient = iso B32TS.encodeBase32 B32TS.decodeBase32Lenient + +-- -- | An 'Iso'' into the Base32hex encoding of a 'ShortText' value +-- -- using lenient decoding. +-- -- +-- -- +-- -- _Note:_ This is not a lawful 'Iso'. +-- -- +-- -- >>> "<>" ^. _Base32HexLenient +-- -- "PDw_Pz4-" +-- -- +-- -- >>> "PDw_Pz4-" ^. from _Base32HexLenient +-- -- "<>" +-- -- +-- _Base32HexLenient :: Iso' ShortText ShortText +-- _Base32HexLenient = iso B32TSH.encodeBase32 B32TSH.decodeBase32Lenient + +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Unidirectional pattern synonym for Base32-encoded 'ShortText' values. +-- +pattern Base32 :: ShortText -> ShortText +pattern Base32 a <- (preview _Base32 -> Just a) where + Base32 a = _Base32 # a + +-- | Unidirectional pattern synonym for unpadded Base32-encoded 'ShortText' values. +-- +pattern Base32Unpadded :: ShortText -> ShortText +pattern Base32Unpadded a <- (preview _Base32Unpadded -> Just a) where + Base32Unpadded a = _Base32Unpadded # a + +-- | Unidirectional pattern synonym for Base32hex-encoded 'ShortText' values. +-- +pattern Base32Hex :: ShortText -> ShortText +pattern Base32Hex a <- (preview _Base32Hex -> Just a) where + Base32Hex a = _Base32Hex # a + +-- | Unidirectional pattern synonym for unpadded Base32hex-encoded 'ShortText' values. +-- +pattern Base32HexUnpadded :: ShortText -> ShortText +pattern Base32HexUnpadded a <- (preview _Base32HexUnpadded -> Just a) where + Base32HexUnpadded a = _Base32HexUnpadded # a + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ShortText' values +-- -- +-- pattern Base32Lenient :: ShortText -> ShortText +-- pattern Base32Lenient a <- (view (from _Base32Lenient) -> a) where +-- Base32Lenient a = view _Base32Lenient a +-- {-# COMPLETE Base32Lenient #-} + +-- -- | Bidirectional pattern synonym for leniently Base32-encoded 'ShortText' values +-- -- +-- pattern Base32HexLenient :: ShortText -> ShortText +-- pattern Base32HexLenient a <- (view (from _Base32HexLenient) -> a) where +-- Base32HexLenient a = view _Base32HexLenient a +-- {-# COMPLETE Base32HexLenient #-} diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import Build_doctests (flags, pkgs, module_sources) -import Test.DocTest (doctest) - -main :: IO () -main = doctest $ flags ++ pkgs ++ module_sources