diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for base64-lens + +## 0.1.0.0 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2020, Emily Pillmore + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Emily Pillmore nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,44 @@ +# Base32-lens + +[![Build Status](https://travis-ci.com/emilypi/base32-lens.svg?branch=master)](https://travis-ci.com/emilypi/base32-lens) +[![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 new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Extra.Doctest (defaultMainWithDoctests) + +main :: IO () +main = defaultMainWithDoctests "doctests" diff --git a/base32-lens.cabal b/base32-lens.cabal new file mode 100644 --- /dev/null +++ b/base32-lens.cabal @@ -0,0 +1,62 @@ +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 +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 + +source-repository head + type: git + location: https://github.com/emilypi/base32.git + + +custom-setup + setup-depends: + base >=4.10 && <5 + , Cabal + , cabal-doctest + + +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 + + build-depends: base >=4.10 && <5 + , base32-lens + , doctest + , lens + + hs-source-dirs: test + ghc-options: -Wall -threaded + x-doctest-options: --fast diff --git a/src/Data/ByteString/Base32/Lens.hs b/src/Data/ByteString/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base32/Lens.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Text.Encoding.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.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 (ByteString) +import qualified Data.ByteString.Base32 as B32 +import qualified Data.ByteString.Base32.Hex as B32H + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.ByteString.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' B32.encodeBase32' $ \s -> case B32.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' B32.encodeBase32Unpadded' $ \s -> case B32.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' B32H.encodeBase32' $ \s -> case B32H.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' B32H.encodeBase32Unpadded' $ \s -> case B32H.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 B32.encodeBase32' B32.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 B32H.encodeBase32' B32H.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/Text/Encoding/Base32/Lens.hs b/src/Data/Text/Encoding/Base32/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Encoding/Base32/Lens.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Text.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.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 (Text) +import qualified Data.Text.Encoding.Base32 as B32T +import qualified Data.Text.Encoding.Base32.Hex as B32TH + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.Text.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' B32T.encodeBase32 $ \s -> case B32T.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' B32T.encodeBase32Unpadded $ \s -> case B32T.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' B32TH.encodeBase32 $ \s -> case B32TH.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' B32TH.encodeBase32Unpadded $ \s -> case B32TH.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 B32T.encodeBase32 B32T.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 B32TH.encodeBase32 B32TH.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/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,7 @@ +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Test.DocTest (doctest) + +main :: IO () +main = doctest $ flags ++ pkgs ++ module_sources