packages feed

one (empty) → 0.0.1

raw patch · 10 files changed

+1312/−0 lines, 10 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, hashable, lens, process, text, unordered-containers

Files

+ LICENCE view
@@ -0,0 +1,27 @@+Copyright 2026 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.1++* This change log starts
+ one.cabal view
@@ -0,0 +1,52 @@+cabal-version:        2.4+name:                 one+version:              0.0.1+synopsis:             One+description:          Data types that have a singleton view+license:              BSD-3-Clause+license-file:         LICENCE+author:               Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer:           Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+copyright:            Copyright (C) 2026 Tony Morris+category:             Data+build-type:           Simple+extra-doc-files:      changelog.md+homepage:             https://gitlab.com/tonymorris/one+bug-reports:          https://gitlab.com/tonymorris/one/issues+tested-with:          GHC == 9.6.7++source-repository     head+  type:               git+  location:           git@gitlab.com:tonymorris/one.git++library+  exposed-modules:+                      Control.One+                      Control.One.AsOne+                      Control.One.GetterOne+                      Control.One.HasOne+                      Control.One.ReviewOne++  build-depends:        base >= 4.8 && < 6+                      , lens >= 4 && < 6+                      , text >= 1.2 && < 3+                      , containers >= 0.5 && < 1+                      , unordered-containers >= 0.2 && < 1+                      , hashable >= 1.2 && < 2+                      , bytestring >= 0.10 && < 1++  hs-source-dirs:     src++  default-language:   Haskell2010++  ghc-options:        -Wall++test-suite doctest+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Main.hs+  build-depends:      base >= 4.8 && < 6+                    , process >= 1 && < 2+  build-tool-depends: doctest:doctest >= 0.22+  default-language:   Haskell2010+  ghc-options:        -Wall
+ src/Control/One.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Type-class abstractions for data types with a singleton view, built on+-- [lens](https://hackage.haskell.org/package/lens).+--+-- == Overview+--+-- Many data types have a natural notion of containing \"exactly one\" element.+-- A 'Data.List.NonEmpty.NonEmpty' list always has a head. An 'Data.Functor.Identity.Identity' always wraps a single+-- value. A 'Data.Set.Set' might contain exactly one element. This library captures+-- these patterns with four type classes, arranged in two parallel hierarchies+-- corresponding to the lens and prism sides:+--+-- @+-- 'GetterOne'        'ReviewOne'+--     |                |+--   'HasOne'           'AsOne'+-- @+--+-- === Lens hierarchy (total access)+--+-- For types that /always/ contain exactly one element:+--+-- * 'GetterOne' — provides @'getOne' :: 'Control.Lens.Getter' x ('GetterOneItem' x)@ to+--   extract the element.+-- * 'HasOne' (superclass: 'GetterOne') — provides @'one' :: 'Control.Lens.Lens'' x ('OneItem' x)@+--   to both get and set the element. A default implementation is derived from+--   'getOne' and 'setOne'.+--+-- === Prism hierarchy (partial access)+--+-- For types that /might/ contain exactly one element:+--+-- * 'ReviewOne' — provides @'reviewOne' :: 'Control.Lens.Review' x ('ReviewOneItem' x)@ to+--   construct a singleton value from an element.+-- * 'AsOne' (superclass: 'ReviewOne') — provides @'_One' :: 'Control.Lens.Prism'' x ('AsOneItem' x)@+--   to both construct and pattern-match singleton values. A default+--   implementation is derived from 'reviewOne' and 'matchOne'.+--+-- == Usage+--+-- === Constructing singleton values+--+-- >>> import Control.Lens (preview, review, set, view)+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> import Data.List.NonEmpty (NonEmpty(..))+-- >>> import Data.Set (Set)+-- >>> review reviewOne 7 :: [Int]+-- [7]+--+-- >>> review reviewOne 7 :: Set Int+-- fromList [7]+--+-- >>> review _One 7 :: Maybe Int+-- Just 7+--+-- === Matching singleton values+--+-- >>> preview _One [7]+-- Just 7+--+-- >>> preview _One [1, 2]+-- Nothing+--+-- >>> preview _One (Nothing :: Maybe Int)+-- Nothing+--+-- === Getting and setting (total types)+--+-- >>> view one (1 :| [2, 3])+-- 1+--+-- >>> set one 9 (1 :| [2, 3])+-- 9 :| [2,3]+--+-- >>> view one (Identity 7)+-- 7+--+-- == Instances+--+-- Instances are provided for a wide range of standard types including:+--+-- * __Containers__: @[]@, 'Data.List.NonEmpty.NonEmpty', 'Data.Sequence.Seq',+--   'Data.Set.Set', 'Data.Map.Map', 'Data.IntSet.IntSet', 'Data.IntMap.IntMap',+--   'Data.HashSet.HashSet', 'Data.HashMap.Strict.HashMap'+-- * __Text and bytes__: 'Data.Text.Text', 'Data.ByteString.ByteString'+--   (strict, lazy, and short variants)+-- * __Maybe and Either__: 'Maybe', 'Either'+-- * __Newtypes__: 'Data.Functor.Identity.Identity', 'Data.Functor.Const.Const',+--   'Data.Semigroup.First', 'Data.Semigroup.Last', 'Data.Semigroup.Min',+--   'Data.Semigroup.Max', 'Data.Semigroup.Dual', 'Data.Semigroup.Sum',+--   'Data.Semigroup.Product', 'Data.Semigroup.WrappedMonoid',+--   'Data.Ord.Down', 'Control.Applicative.ZipList', 'GHC.Generics.Par1', 'Data.Tuple.Solo'+-- * __Tuples__: @(x, a)@+--+-- Types that always contain one element (e.g. 'Data.Functor.Identity.Identity',+-- 'Data.List.NonEmpty.NonEmpty', 'Data.Tuple.Solo') have instances for all four classes.+-- Types that might contain one element (e.g. @[]@, 'Maybe', 'Data.Set.Set')+-- have instances only for the prism side ('ReviewOne' and 'AsOne').+module Control.One (module O) where++import Control.One.AsOne as O+import Control.One.GetterOne as O+import Control.One.HasOne as O+import Control.One.ReviewOne as O
+ src/Control/One/AsOne.hs view
@@ -0,0 +1,478 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wall -Werror #-}++module Control.One.AsOne where++import Control.Applicative (Const (..), ZipList (..))+import Control.Lens (Prism', preview, prism', review, view, _Just, _Right, _Wrapped)+import Control.One.ReviewOne (ReviewOne (ReviewOneItem, reviewOne))+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.ByteString.Short as ShortByteString+import Data.Functor.Identity (Identity (..))+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet+import Data.Hashable (Hashable)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Ord (Down (..))+import Data.Semigroup (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..), Sum (..), WrappedMonoid (..))+import Data.Sequence (Seq, pattern (:<|))+import qualified Data.Sequence as Sequence+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import Data.Tuple (Solo (..))+import Data.Word (Word8)+import GHC.Generics (Par1 (..))++class (ReviewOne x) => AsOne x where+  type AsOneItem x++  matchOne :: x -> Maybe (AsOneItem x)++  _One :: Prism' x (AsOneItem x)+  default _One :: (ReviewOneItem x ~ AsOneItem x) => Prism' x (AsOneItem x)+  _One = prism' (review reviewOne) matchOne++-- | >>> preview _One [7]+-- Just 7+--+-- >>> preview _One [1, 2]+-- Nothing+--+-- >>> preview _One ([] :: [Int])+-- Nothing+--+-- >>> review _One 7 :: [Int]+-- [7]+instance AsOne [a] where+  type AsOneItem [a] = a++  matchOne = \case+    [a] -> Just a+    _ -> Nothing++-- | >>> preview _One (7 :| [])+-- Just 7+--+-- >>> preview _One (1 :| [2])+-- Nothing+--+-- >>> review _One 7 :: NonEmpty Int+-- 7 :| []+instance AsOne (NonEmpty a) where+  type AsOneItem (NonEmpty a) = a++  matchOne = \case+    a :| [] -> Just a+    _ -> Nothing++-- | >>> preview _One (Sequence.singleton 7)+-- Just 7+--+-- >>> preview _One (Sequence.fromList [1, 2])+-- Nothing+--+-- >>> preview _One Sequence.empty+-- Nothing+--+-- >>> review _One 7 :: Seq Int+-- fromList [7]+instance AsOne (Seq a) where+  type AsOneItem (Seq a) = a++  matchOne = \case+    a :<| Sequence.Empty -> Just a+    _ -> Nothing++-- | >>> preview _One (Text.singleton 'a')+-- Just 'a'+--+-- >>> preview _One (Text.pack "ab")+-- Nothing+--+-- >>> preview _One Text.empty+-- Nothing+--+-- >>> review _One 'a' :: Text.Text+-- "a"+instance AsOne Text.Text where+  type AsOneItem Text.Text = Char++  matchOne x = case Text.uncons x of+    Just (c, rest) | Text.null rest -> Just c+    _ -> Nothing++-- | >>> preview _One (LazyText.singleton 'a')+-- Just 'a'+--+-- >>> preview _One (LazyText.pack "ab")+-- Nothing+--+-- >>> review _One 'a' :: LazyText.Text+-- "a"+instance AsOne LazyText.Text where+  type AsOneItem LazyText.Text = Char++  matchOne x = case LazyText.uncons x of+    Just (c, rest) | LazyText.null rest -> Just c+    _ -> Nothing++-- | >>> preview _One (ByteString.singleton 65)+-- Just 65+--+-- >>> preview _One (ByteString.pack [1, 2])+-- Nothing+--+-- >>> preview _One ByteString.empty+-- Nothing+--+-- >>> review _One 65 :: ByteString.ByteString+-- "A"+instance AsOne ByteString.ByteString where+  type AsOneItem ByteString.ByteString = Word8++  matchOne x = case ByteString.uncons x of+    Just (w, rest) | ByteString.null rest -> Just w+    _ -> Nothing++-- | >>> preview _One (LazyByteString.singleton 65)+-- Just 65+--+-- >>> preview _One (LazyByteString.pack [1, 2])+-- Nothing+--+-- >>> review _One 65 :: LazyByteString.ByteString+-- "A"+instance AsOne LazyByteString.ByteString where+  type AsOneItem LazyByteString.ByteString = Word8++  matchOne x = case LazyByteString.uncons x of+    Just (w, rest) | LazyByteString.null rest -> Just w+    _ -> Nothing++-- | >>> preview _One (ShortByteString.singleton 65)+-- Just 65+--+-- >>> preview _One (ShortByteString.pack [1, 2])+-- Nothing+--+-- >>> review _One 65 :: ShortByteString.ShortByteString+-- "A"+instance AsOne ShortByteString.ShortByteString where+  type AsOneItem ShortByteString.ShortByteString = Word8++  matchOne x =+    if ShortByteString.length x == 1 then Just (ShortByteString.index x 0) else Nothing++-- | >>> preview _One (Map.singleton "key" (7 :: Int))+-- Just ("key",7)+--+-- >>> preview _One (Map.fromList [("a", 1), ("b", 2)] :: Map String Int)+-- Nothing+--+-- >>> review _One ("key", 7) :: Map String Int+-- fromList [("key",7)]+instance AsOne (Map k v) where+  type AsOneItem (Map k v) = (k, v)++  matchOne x =+    if Map.size x == 1 then Just (Map.findMin x) else Nothing++-- | >>> preview _One (HashMap.singleton "key" (7 :: Int))+-- Just ("key",7)+--+-- >>> review _One ("key", 7) :: HashMap String Int+-- fromList [("key",7)]+instance (Hashable k) => AsOne (HashMap k v) where+  type AsOneItem (HashMap k v) = (k, v)++  matchOne x =+    case HashMap.toList x of+      [kv] -> Just kv+      _ -> Nothing++-- | >>> preview _One (IntMap.singleton 1 7)+-- Just (1,7)+--+-- >>> preview _One (IntMap.fromList [(1, 2), (3, 4)])+-- Nothing+--+-- >>> review _One (1, 7) :: IntMap Int+-- fromList [(1,7)]+instance AsOne (IntMap v) where+  type AsOneItem (IntMap v) = (Int, v)++  matchOne x =+    if IntMap.size x == 1 then Just (IntMap.findMin x) else Nothing++-- | >>> preview _One (Set.singleton 7)+-- Just 7+--+-- >>> preview _One (Set.fromList [1, 2])+-- Nothing+--+-- >>> review _One 7 :: Set Int+-- fromList [7]+instance AsOne (Set a) where+  type AsOneItem (Set a) = a++  matchOne x =+    if Set.size x == 1 then Just (Set.findMin x) else Nothing++-- | >>> preview _One (HashSet.singleton 7)+-- Just 7+--+-- >>> review _One 7 :: HashSet Int+-- fromList [7]+instance (Hashable a) => AsOne (HashSet a) where+  type AsOneItem (HashSet a) = a++  matchOne x =+    case HashSet.toList x of+      [a] -> Just a+      _ -> Nothing++-- | >>> preview _One (IntSet.singleton 7)+-- Just 7+--+-- >>> preview _One (IntSet.fromList [1, 2])+-- Nothing+--+-- >>> review _One 7 :: IntSet+-- fromList [7]+instance AsOne IntSet where+  type AsOneItem IntSet = Int++  matchOne x =+    if IntSet.size x == 1 then Just (IntSet.findMin x) else Nothing++-- | >>> preview _One ("", 7 :: Int) :: Maybe Int+-- Just 7+--+-- >>> preview _One ("nonempty", 7 :: Int) :: Maybe Int+-- Nothing+--+-- >>> review _One 7 :: (String, Int)+-- ("",7)+instance (Eq a, Monoid a) => AsOne (a, b) where+  type AsOneItem (a, b) = b++  matchOne = \case+    (a, b) -> if a == mempty then Just b else Nothing++-- | >>> preview _One (Just 7)+-- Just 7+--+-- >>> preview _One (Nothing :: Maybe Int)+-- Nothing+--+-- >>> review _One 7 :: Maybe Int+-- Just 7+instance AsOne (Maybe a) where+  type AsOneItem (Maybe a) = a++  matchOne =+    preview _Just+  {-# INLINE matchOne #-}++-- | >>> preview _One (Right 7 :: Either String Int)+-- Just 7+--+-- >>> preview _One (Left "err" :: Either String Int)+-- Nothing+--+-- >>> review _One 7 :: Either String Int+-- Right 7+instance AsOne (Either a b) where+  type AsOneItem (Either a b) = b++  matchOne =+    preview _Right+  {-# INLINE matchOne #-}++-- | >>> preview _One (Identity 7)+-- Just 7+--+-- >>> review _One 7 :: Identity Int+-- Identity 7+instance AsOne (Identity a) where+  type AsOneItem (Identity a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Const 7 :: Const Int String)+-- Just 7+--+-- >>> review _One 7 :: Const Int String+-- Const 7+instance AsOne (Const a b) where+  type AsOneItem (Const a b) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (First 7)+-- Just 7+--+-- >>> review _One 7 :: First Int+-- First {getFirst = 7}+instance AsOne (First a) where+  type AsOneItem (First a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Last 7)+-- Just 7+--+-- >>> review _One 7 :: Last Int+-- Last {getLast = 7}+instance AsOne (Last a) where+  type AsOneItem (Last a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (WrapMonoid 7)+-- Just 7+--+-- >>> review _One 7 :: WrappedMonoid Int+-- WrapMonoid {unwrapMonoid = 7}+instance AsOne (WrappedMonoid a) where+  type AsOneItem (WrappedMonoid a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Dual 7)+-- Just 7+--+-- >>> review _One 7 :: Dual Int+-- Dual {getDual = 7}+instance AsOne (Dual a) where+  type AsOneItem (Dual a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Down 7)+-- Just 7+--+-- >>> review _One 7 :: Down Int+-- Down 7+instance AsOne (Down a) where+  type AsOneItem (Down a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Sum 7)+-- Just 7+--+-- >>> review _One 7 :: Sum Int+-- Sum {getSum = 7}+instance AsOne (Sum a) where+  type AsOneItem (Sum a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Product 7)+-- Just 7+--+-- >>> review _One 7 :: Product Int+-- Product {getProduct = 7}+instance AsOne (Product a) where+  type AsOneItem (Product a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Min 7)+-- Just 7+--+-- >>> review _One 7 :: Min Int+-- Min {getMin = 7}+instance AsOne (Min a) where+  type AsOneItem (Min a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Max 7)+-- Just 7+--+-- >>> review _One 7 :: Max Int+-- Max {getMax = 7}+instance AsOne (Max a) where+  type AsOneItem (Max a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (ZipList [7])+-- Just 7+--+-- >>> preview _One (ZipList [1, 2])+-- Nothing+--+-- >>> preview _One (ZipList ([] :: [Int]))+-- Nothing+--+-- >>> review _One 7 :: ZipList Int+-- ZipList {getZipList = [7]}+instance AsOne (ZipList a) where+  type AsOneItem (ZipList a) = a++  matchOne =+    matchOne . view _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (Par1 7)+-- Just 7+--+-- >>> review _One 7 :: Par1 Int+-- Par1 {unPar1 = 7}+instance AsOne (Par1 a) where+  type AsOneItem (Par1 a) = a++  matchOne =+    preview _Wrapped+  {-# INLINE matchOne #-}++-- | >>> preview _One (MkSolo 7)+-- Just 7+--+-- >>> review _One 7 :: Solo Int+-- MkSolo 7+instance AsOne (Solo a) where+  type AsOneItem (Solo a) = a++  matchOne (MkSolo x) = Just x+  {-# INLINE matchOne #-}
+ src/Control/One/GetterOne.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -Werror #-}++module Control.One.GetterOne where++import Control.Applicative (Const (..))+import Control.Lens (Getter, to, _Wrapped)+import Data.Functor.Identity (Identity (..))+import Data.List.NonEmpty (NonEmpty (..))+import Data.Ord (Down (..))+import Data.Semigroup (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..), Sum (..), WrappedMonoid (..))+import Data.Tuple (Solo (..))+import GHC.Generics (Par1 (..))++-- $setup+-- >>> import Control.Lens (view)++class GetterOne x where+  type GetterOneItem x++  getOne :: Getter x (GetterOneItem x)++-- | >>> view getOne (1 :| [2, 3])+-- 1+instance GetterOne (NonEmpty a) where+  type GetterOneItem (NonEmpty a) = a++  getOne = to (\(a :| _) -> a)++-- | >>> view getOne ("hello", 42 :: Int)+-- 42+instance GetterOne (x, a) where+  type GetterOneItem (x, a) = a++  getOne = to snd++-- | >>> view getOne (Identity 7)+-- 7+instance GetterOne (Identity a) where+  type GetterOneItem (Identity a) = a++  getOne = _Wrapped++-- | >>> view getOne (Const 7 :: Const Int String)+-- 7+instance GetterOne (Const a b) where+  type GetterOneItem (Const a b) = a++  getOne = _Wrapped++-- | >>> view getOne (First 7)+-- 7+instance GetterOne (First a) where+  type GetterOneItem (First a) = a++  getOne = _Wrapped++-- | >>> view getOne (Last 7)+-- 7+instance GetterOne (Last a) where+  type GetterOneItem (Last a) = a++  getOne = _Wrapped++-- | >>> view getOne (WrapMonoid "hello")+-- "hello"+instance GetterOne (WrappedMonoid a) where+  type GetterOneItem (WrappedMonoid a) = a++  getOne = _Wrapped++-- | >>> view getOne (Dual 7)+-- 7+instance GetterOne (Dual a) where+  type GetterOneItem (Dual a) = a++  getOne = _Wrapped++-- | >>> view getOne (Down 7)+-- 7+instance GetterOne (Down a) where+  type GetterOneItem (Down a) = a++  getOne = _Wrapped++-- | >>> view getOne (Sum 7)+-- 7+instance GetterOne (Sum a) where+  type GetterOneItem (Sum a) = a++  getOne = _Wrapped++-- | >>> view getOne (Product 7)+-- 7+instance GetterOne (Product a) where+  type GetterOneItem (Product a) = a++  getOne = _Wrapped++-- | >>> view getOne (Min 7)+-- 7+instance GetterOne (Min a) where+  type GetterOneItem (Min a) = a++  getOne = _Wrapped++-- | >>> view getOne (Max 7)+-- 7+instance GetterOne (Max a) where+  type GetterOneItem (Max a) = a++  getOne = _Wrapped++-- | >>> view getOne (Par1 7)+-- 7+instance GetterOne (Par1 a) where+  type GetterOneItem (Par1 a) = a++  getOne = _Wrapped++-- | >>> view getOne (MkSolo 7)+-- 7+instance GetterOne (Solo a) where+  type GetterOneItem (Solo a) = a++  getOne = to (\(MkSolo a) -> a)
+ src/Control/One/HasOne.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wall -Werror #-}++module Control.One.HasOne where++import Control.Applicative (Const (..))+import Control.Lens (Lens', lens, view)+import Control.One.GetterOne (GetterOne (GetterOneItem, getOne))+import Data.Functor.Identity (Identity (..))+import Data.List.NonEmpty (NonEmpty (..))+import Data.Ord (Down (..))+import Data.Semigroup (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..), Sum (..), WrappedMonoid (..))+import Data.Tuple (Solo (..))+import GHC.Generics (Par1 (..))++-- $setup+-- >>> import Control.Lens (set)++class (GetterOne x) => HasOne x where+  type OneItem x++  setOne :: x -> OneItem x -> x++  one :: Lens' x (OneItem x)+  default one :: (GetterOneItem x ~ OneItem x) => Lens' x (OneItem x)+  one = lens (view getOne) setOne++-- | >>> view one (1 :| [2, 3])+-- 1+--+-- >>> set one 9 (1 :| [2, 3])+-- 9 :| [2,3]+instance HasOne (NonEmpty a) where+  type OneItem (NonEmpty a) = a++  setOne (_ :| xs) a = a :| xs++-- | >>> view one ("hello", 42 :: Int)+-- 42+--+-- >>> set one 9 ("hello", 42 :: Int)+-- ("hello",9)+instance HasOne (x, a) where+  type OneItem (x, a) = a++  setOne (x, _) a = (x, a)++-- | >>> view one (Identity 7)+-- 7+--+-- >>> set one 9 (Identity 7)+-- Identity 9+instance HasOne (Identity a) where+  type OneItem (Identity a) = a++  setOne _ = Identity++-- | >>> view one (Const 7 :: Const Int String)+-- 7+--+-- >>> set one 9 (Const 7 :: Const Int String)+-- Const 9+instance HasOne (Const a b) where+  type OneItem (Const a b) = a++  setOne _ = Const++-- | >>> view one (First 7)+-- 7+--+-- >>> set one 9 (First 7)+-- First {getFirst = 9}+instance HasOne (First a) where+  type OneItem (First a) = a++  setOne _ = First++-- | >>> view one (Last 7)+-- 7+--+-- >>> set one 9 (Last 7)+-- Last {getLast = 9}+instance HasOne (Last a) where+  type OneItem (Last a) = a++  setOne _ = Last++-- | >>> view one (WrapMonoid "hello")+-- "hello"+--+-- >>> set one "world" (WrapMonoid "hello")+-- WrapMonoid {unwrapMonoid = "world"}+instance HasOne (WrappedMonoid a) where+  type OneItem (WrappedMonoid a) = a++  setOne _ = WrapMonoid++-- | >>> view one (Dual 7)+-- 7+--+-- >>> set one 9 (Dual 7)+-- Dual {getDual = 9}+instance HasOne (Dual a) where+  type OneItem (Dual a) = a++  setOne _ = Dual++-- | >>> view one (Down 7)+-- 7+--+-- >>> set one 9 (Down 7)+-- Down 9+instance HasOne (Down a) where+  type OneItem (Down a) = a++  setOne _ = Down++-- | >>> view one (Sum 7)+-- 7+--+-- >>> set one 9 (Sum 7)+-- Sum {getSum = 9}+instance HasOne (Sum a) where+  type OneItem (Sum a) = a++  setOne _ = Sum++-- | >>> view one (Product 7)+-- 7+--+-- >>> set one 9 (Product 7)+-- Product {getProduct = 9}+instance HasOne (Product a) where+  type OneItem (Product a) = a++  setOne _ = Product++-- | >>> view one (Min 7)+-- 7+--+-- >>> set one 9 (Min 7)+-- Min {getMin = 9}+instance HasOne (Min a) where+  type OneItem (Min a) = a++  setOne _ = Min++-- | >>> view one (Max 7)+-- 7+--+-- >>> set one 9 (Max 7)+-- Max {getMax = 9}+instance HasOne (Max a) where+  type OneItem (Max a) = a++  setOne _ = Max++-- | >>> view one (Par1 7)+-- 7+--+-- >>> set one 9 (Par1 7)+-- Par1 {unPar1 = 9}+instance HasOne (Par1 a) where+  type OneItem (Par1 a) = a++  setOne _ = Par1++-- | >>> view one (MkSolo 7)+-- 7+--+-- >>> set one 9 (MkSolo 7)+-- MkSolo 9+instance HasOne (Solo a) where+  type OneItem (Solo a) = a++  setOne _ = MkSolo
+ src/Control/One/ReviewOne.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wall -Werror #-}++module Control.One.ReviewOne where++import Control.Applicative (Const, ZipList)+import Control.Lens (Review, unto, _Just, _Right, _Wrapped)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.ByteString.Short as ShortByteString+import Data.Functor.Identity (Identity)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet+import Data.Hashable (Hashable)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Ord (Down)+import Data.Semigroup (Dual, First, Last, Max, Min, Product, Sum, WrappedMonoid)+import Data.Sequence (Seq)+import qualified Data.Sequence as Sequence+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import Data.Tuple (Solo (..))+import Data.Word (Word8)+import GHC.Generics (Par1)++-- $setup+-- >>> import Control.Lens (review)++class ReviewOne x where+  type ReviewOneItem x++  reviewOne :: Review x (ReviewOneItem x)++-- | >>> review reviewOne 7 :: [Int]+-- [7]+instance ReviewOne [a] where+  type ReviewOneItem [a] = a++  reviewOne = unto (: [])++-- | >>> review reviewOne 7 :: NonEmpty Int+-- 7 :| []+instance ReviewOne (NonEmpty a) where+  type ReviewOneItem (NonEmpty a) = a++  reviewOne =+    unto+      (:| [])++-- | >>> review reviewOne 7 :: Seq Int+-- fromList [7]+instance ReviewOne (Seq a) where+  type ReviewOneItem (Seq a) = a++  reviewOne =+    unto+      Sequence.singleton++-- | >>> review reviewOne 'a' :: Text.Text+-- "a"+instance ReviewOne Text.Text where+  type ReviewOneItem Text.Text = Char++  reviewOne =+    unto+      Text.singleton++-- | >>> review reviewOne 'a' :: LazyText.Text+-- "a"+instance ReviewOne LazyText.Text where+  type ReviewOneItem LazyText.Text = Char++  reviewOne =+    unto+      LazyText.singleton++-- | >>> review reviewOne 65 :: ByteString.ByteString+-- "A"+instance ReviewOne ByteString.ByteString where+  type ReviewOneItem ByteString.ByteString = Word8++  reviewOne =+    unto+      ByteString.singleton++-- | >>> review reviewOne 65 :: LazyByteString.ByteString+-- "A"+instance ReviewOne LazyByteString.ByteString where+  type ReviewOneItem LazyByteString.ByteString = Word8++  reviewOne =+    unto+      LazyByteString.singleton++-- | >>> review reviewOne 65 :: ShortByteString.ShortByteString+-- "A"+instance ReviewOne ShortByteString.ShortByteString where+  type ReviewOneItem ShortByteString.ShortByteString = Word8++  reviewOne =+    unto+      ShortByteString.singleton++-- | >>> review reviewOne ("key", 7 :: Int) :: Map String Int+-- fromList [("key",7)]+instance ReviewOne (Map k v) where+  type ReviewOneItem (Map k v) = (k, v)++  reviewOne =+    unto+      (uncurry Map.singleton)++-- | >>> review reviewOne ("key", 7 :: Int) :: HashMap String Int+-- fromList [("key",7)]+instance (Hashable k) => ReviewOne (HashMap k v) where+  type ReviewOneItem (HashMap k v) = (k, v)++  reviewOne =+    unto+      (uncurry HashMap.singleton)++-- | >>> review reviewOne (1, 7 :: Int) :: IntMap Int+-- fromList [(1,7)]+instance ReviewOne (IntMap v) where+  type ReviewOneItem (IntMap v) = (Int, v)++  reviewOne =+    unto+      (uncurry IntMap.singleton)++-- | >>> review reviewOne 7 :: Set Int+-- fromList [7]+instance ReviewOne (Set a) where+  type ReviewOneItem (Set a) = a++  reviewOne =+    unto+      Set.singleton++-- | >>> review reviewOne 7 :: HashSet Int+-- fromList [7]+instance (Hashable a) => ReviewOne (HashSet a) where+  type ReviewOneItem (HashSet a) = a++  reviewOne =+    unto+      HashSet.singleton++-- | >>> review reviewOne 7 :: IntSet+-- fromList [7]+instance ReviewOne IntSet where+  type ReviewOneItem IntSet = Int++  reviewOne =+    unto+      IntSet.singleton++-- | >>> review reviewOne 7 :: (String, Int)+-- ("",7)+instance (Eq a, Monoid a) => ReviewOne (a, b) where+  type ReviewOneItem (a, b) = b++  reviewOne =+    unto+      (mempty,)++-- | >>> review reviewOne 7 :: Maybe Int+-- Just 7+instance ReviewOne (Maybe a) where+  type ReviewOneItem (Maybe a) = a++  reviewOne =+    _Just+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Either String Int+-- Right 7+instance ReviewOne (Either a b) where+  type ReviewOneItem (Either a b) = b++  reviewOne =+    _Right+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Identity Int+-- Identity 7+instance ReviewOne (Identity a) where+  type ReviewOneItem (Identity a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Const Int String+-- Const 7+instance ReviewOne (Const a b) where+  type ReviewOneItem (Const a b) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: First Int+-- First {getFirst = 7}+instance ReviewOne (First a) where+  type ReviewOneItem (First a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Last Int+-- Last {getLast = 7}+instance ReviewOne (Last a) where+  type ReviewOneItem (Last a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: WrappedMonoid Int+-- WrapMonoid {unwrapMonoid = 7}+instance ReviewOne (WrappedMonoid a) where+  type ReviewOneItem (WrappedMonoid a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Dual Int+-- Dual {getDual = 7}+instance ReviewOne (Dual a) where+  type ReviewOneItem (Dual a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Down Int+-- Down 7+instance ReviewOne (Down a) where+  type ReviewOneItem (Down a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Sum Int+-- Sum {getSum = 7}+instance ReviewOne (Sum a) where+  type ReviewOneItem (Sum a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Product Int+-- Product {getProduct = 7}+instance ReviewOne (Product a) where+  type ReviewOneItem (Product a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Min Int+-- Min {getMin = 7}+instance ReviewOne (Min a) where+  type ReviewOneItem (Min a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Max Int+-- Max {getMax = 7}+instance ReviewOne (Max a) where+  type ReviewOneItem (Max a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: ZipList Int+-- ZipList {getZipList = [7]}+instance ReviewOne (ZipList a) where+  type ReviewOneItem (ZipList a) = a++  reviewOne =+    _Wrapped . reviewOne+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Par1 Int+-- Par1 {unPar1 = 7}+instance ReviewOne (Par1 a) where+  type ReviewOneItem (Par1 a) = a++  reviewOne =+    _Wrapped+  {-# INLINE reviewOne #-}++-- | >>> review reviewOne 7 :: Solo Int+-- MkSolo 7+instance ReviewOne (Solo a) where+  type ReviewOneItem (Solo a) = a++  reviewOne =+    unto+      MkSolo+  {-# INLINE reviewOne #-}
+ test/Main.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+  exitWith+    =<< rawSystem+      "cabal"+      [ "repl",+        "--with-compiler=doctest",+        "--repl-options=-w",+        "--repl-options=-Wdefault",+        "lib:one"+      ]