one-0.0.2: src/Control/One/AsOneItem.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall -Werror #-}

module Control.One.AsOneItem where

import Control.Applicative (Const (..), ZipList (..))
import Control.Lens (Prism', preview, prism', review, view, _Just, _Right, _Wrapped)
import Control.One.ReviewOneItem (ReviewOneItem (ReviewOneItemElement, reviewOneItem))
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 qualified Data.Text.Short as ShortText
import Data.Tuple (Solo (..))
import Data.Word (Word8)
import GHC.Generics (Par1 (..))

class (ReviewOneItem x) => AsOneItem x where
  type AsOneItemElement x

  matchOneItem :: x -> Maybe (AsOneItemElement x)

  _OneItem :: Prism' x (AsOneItemElement x)
  default _OneItem :: (ReviewOneItemElement x ~ AsOneItemElement x) => Prism' x (AsOneItemElement x)
  _OneItem = prism' (review reviewOneItem) matchOneItem

-- | >>> preview _OneItem [7]
-- Just 7
--
-- >>> preview _OneItem [1, 2]
-- Nothing
--
-- >>> preview _OneItem ([] :: [Int])
-- Nothing
--
-- >>> review _OneItem 7 :: [Int]
-- [7]
instance AsOneItem [a] where
  type AsOneItemElement [a] = a

  matchOneItem = \case
    [a] -> Just a
    _ -> Nothing

-- | >>> preview _OneItem (7 :| [])
-- Just 7
--
-- >>> preview _OneItem (1 :| [2])
-- Nothing
--
-- >>> review _OneItem 7 :: NonEmpty Int
-- 7 :| []
instance AsOneItem (NonEmpty a) where
  type AsOneItemElement (NonEmpty a) = a

  matchOneItem = \case
    a :| [] -> Just a
    _ -> Nothing

-- | >>> preview _OneItem (Sequence.singleton 7)
-- Just 7
--
-- >>> preview _OneItem (Sequence.fromList [1, 2])
-- Nothing
--
-- >>> preview _OneItem Sequence.empty
-- Nothing
--
-- >>> review _OneItem 7 :: Seq Int
-- fromList [7]
instance AsOneItem (Seq a) where
  type AsOneItemElement (Seq a) = a

  matchOneItem = \case
    a :<| Sequence.Empty -> Just a
    _ -> Nothing

-- | >>> preview _OneItem (Text.singleton 'a')
-- Just 'a'
--
-- >>> preview _OneItem (Text.pack "ab")
-- Nothing
--
-- >>> preview _OneItem Text.empty
-- Nothing
--
-- >>> review _OneItem 'a' :: Text.Text
-- "a"
instance AsOneItem Text.Text where
  type AsOneItemElement Text.Text = Char

  matchOneItem x = case Text.uncons x of
    Just (c, rest) | Text.null rest -> Just c
    _ -> Nothing

-- | >>> preview _OneItem (LazyText.singleton 'a')
-- Just 'a'
--
-- >>> preview _OneItem (LazyText.pack "ab")
-- Nothing
--
-- >>> review _OneItem 'a' :: LazyText.Text
-- "a"
instance AsOneItem LazyText.Text where
  type AsOneItemElement LazyText.Text = Char

  matchOneItem x = case LazyText.uncons x of
    Just (c, rest) | LazyText.null rest -> Just c
    _ -> Nothing

-- | >>> preview _OneItem (ShortText.singleton 'a')
-- Just 'a'
--
-- >>> preview _OneItem (ShortText.pack "ab")
-- Nothing
--
-- >>> preview _OneItem (ShortText.pack "")
-- Nothing
--
-- >>> review _OneItem 'a' :: ShortText.ShortText
-- "a"
instance AsOneItem ShortText.ShortText where
  type AsOneItemElement ShortText.ShortText = Char

  matchOneItem x = case ShortText.uncons x of
    Just (c, rest) | ShortText.null rest -> Just c
    _ -> Nothing

-- | >>> preview _OneItem (ByteString.singleton 65)
-- Just 65
--
-- >>> preview _OneItem (ByteString.pack [1, 2])
-- Nothing
--
-- >>> preview _OneItem ByteString.empty
-- Nothing
--
-- >>> review _OneItem 65 :: ByteString.ByteString
-- "A"
instance AsOneItem ByteString.ByteString where
  type AsOneItemElement ByteString.ByteString = Word8

  matchOneItem x = case ByteString.uncons x of
    Just (w, rest) | ByteString.null rest -> Just w
    _ -> Nothing

-- | >>> preview _OneItem (LazyByteString.singleton 65)
-- Just 65
--
-- >>> preview _OneItem (LazyByteString.pack [1, 2])
-- Nothing
--
-- >>> review _OneItem 65 :: LazyByteString.ByteString
-- "A"
instance AsOneItem LazyByteString.ByteString where
  type AsOneItemElement LazyByteString.ByteString = Word8

  matchOneItem x = case LazyByteString.uncons x of
    Just (w, rest) | LazyByteString.null rest -> Just w
    _ -> Nothing

-- | >>> preview _OneItem (ShortByteString.singleton 65)
-- Just 65
--
-- >>> preview _OneItem (ShortByteString.pack [1, 2])
-- Nothing
--
-- >>> review _OneItem 65 :: ShortByteString.ShortByteString
-- "A"
instance AsOneItem ShortByteString.ShortByteString where
  type AsOneItemElement ShortByteString.ShortByteString = Word8

  matchOneItem x =
    if ShortByteString.length x == 1 then Just (ShortByteString.index x 0) else Nothing

-- | >>> preview _OneItem (Map.singleton "key" (7 :: Int))
-- Just ("key",7)
--
-- >>> preview _OneItem (Map.fromList [("a", 1), ("b", 2)] :: Map String Int)
-- Nothing
--
-- >>> review _OneItem ("key", 7) :: Map String Int
-- fromList [("key",7)]
instance AsOneItem (Map k v) where
  type AsOneItemElement (Map k v) = (k, v)

  matchOneItem x =
    if Map.size x == 1 then Just (Map.findMin x) else Nothing

-- | >>> preview _OneItem (HashMap.singleton "key" (7 :: Int))
-- Just ("key",7)
--
-- >>> review _OneItem ("key", 7) :: HashMap String Int
-- fromList [("key",7)]
instance (Hashable k) => AsOneItem (HashMap k v) where
  type AsOneItemElement (HashMap k v) = (k, v)

  matchOneItem x =
    case HashMap.toList x of
      [kv] -> Just kv
      _ -> Nothing

-- | >>> preview _OneItem (IntMap.singleton 1 7)
-- Just (1,7)
--
-- >>> preview _OneItem (IntMap.fromList [(1, 2), (3, 4)])
-- Nothing
--
-- >>> review _OneItem (1, 7) :: IntMap Int
-- fromList [(1,7)]
instance AsOneItem (IntMap v) where
  type AsOneItemElement (IntMap v) = (Int, v)

  matchOneItem x =
    if IntMap.size x == 1 then Just (IntMap.findMin x) else Nothing

-- | >>> preview _OneItem (Set.singleton 7)
-- Just 7
--
-- >>> preview _OneItem (Set.fromList [1, 2])
-- Nothing
--
-- >>> review _OneItem 7 :: Set Int
-- fromList [7]
instance AsOneItem (Set a) where
  type AsOneItemElement (Set a) = a

  matchOneItem x =
    if Set.size x == 1 then Just (Set.findMin x) else Nothing

-- | >>> preview _OneItem (HashSet.singleton 7)
-- Just 7
--
-- >>> review _OneItem 7 :: HashSet Int
-- fromList [7]
instance (Hashable a) => AsOneItem (HashSet a) where
  type AsOneItemElement (HashSet a) = a

  matchOneItem x =
    case HashSet.toList x of
      [a] -> Just a
      _ -> Nothing

-- | >>> preview _OneItem (IntSet.singleton 7)
-- Just 7
--
-- >>> preview _OneItem (IntSet.fromList [1, 2])
-- Nothing
--
-- >>> review _OneItem 7 :: IntSet
-- fromList [7]
instance AsOneItem IntSet where
  type AsOneItemElement IntSet = Int

  matchOneItem x =
    if IntSet.size x == 1 then Just (IntSet.findMin x) else Nothing

-- | >>> preview _OneItem ("", 7 :: Int) :: Maybe Int
-- Just 7
--
-- >>> preview _OneItem ("nonempty", 7 :: Int) :: Maybe Int
-- Nothing
--
-- >>> review _OneItem 7 :: (String, Int)
-- ("",7)
instance (Eq a, Monoid a) => AsOneItem (a, b) where
  type AsOneItemElement (a, b) = b

  matchOneItem = \case
    (a, b) -> if a == mempty then Just b else Nothing

-- | >>> preview _OneItem (Just 7)
-- Just 7
--
-- >>> preview _OneItem (Nothing :: Maybe Int)
-- Nothing
--
-- >>> review _OneItem 7 :: Maybe Int
-- Just 7
instance AsOneItem (Maybe a) where
  type AsOneItemElement (Maybe a) = a

  matchOneItem =
    preview _Just
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Right 7 :: Either String Int)
-- Just 7
--
-- >>> preview _OneItem (Left "err" :: Either String Int)
-- Nothing
--
-- >>> review _OneItem 7 :: Either String Int
-- Right 7
instance AsOneItem (Either a b) where
  type AsOneItemElement (Either a b) = b

  matchOneItem =
    preview _Right
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Identity 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Identity Int
-- Identity 7
instance AsOneItem (Identity a) where
  type AsOneItemElement (Identity a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Const 7 :: Const Int String)
-- Just 7
--
-- >>> review _OneItem 7 :: Const Int String
-- Const 7
instance AsOneItem (Const a b) where
  type AsOneItemElement (Const a b) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (First 7)
-- Just 7
--
-- >>> review _OneItem 7 :: First Int
-- First {getFirst = 7}
instance AsOneItem (First a) where
  type AsOneItemElement (First a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Last 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Last Int
-- Last {getLast = 7}
instance AsOneItem (Last a) where
  type AsOneItemElement (Last a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (WrapMonoid 7)
-- Just 7
--
-- >>> review _OneItem 7 :: WrappedMonoid Int
-- WrapMonoid {unwrapMonoid = 7}
instance AsOneItem (WrappedMonoid a) where
  type AsOneItemElement (WrappedMonoid a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Dual 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Dual Int
-- Dual {getDual = 7}
instance AsOneItem (Dual a) where
  type AsOneItemElement (Dual a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Down 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Down Int
-- Down 7
instance AsOneItem (Down a) where
  type AsOneItemElement (Down a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Sum 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Sum Int
-- Sum {getSum = 7}
instance AsOneItem (Sum a) where
  type AsOneItemElement (Sum a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Product 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Product Int
-- Product {getProduct = 7}
instance AsOneItem (Product a) where
  type AsOneItemElement (Product a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Min 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Min Int
-- Min {getMin = 7}
instance AsOneItem (Min a) where
  type AsOneItemElement (Min a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Max 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Max Int
-- Max {getMax = 7}
instance AsOneItem (Max a) where
  type AsOneItemElement (Max a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (ZipList [7])
-- Just 7
--
-- >>> preview _OneItem (ZipList [1, 2])
-- Nothing
--
-- >>> preview _OneItem (ZipList ([] :: [Int]))
-- Nothing
--
-- >>> review _OneItem 7 :: ZipList Int
-- ZipList {getZipList = [7]}
instance AsOneItem (ZipList a) where
  type AsOneItemElement (ZipList a) = a

  matchOneItem =
    matchOneItem . view _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (Par1 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Par1 Int
-- Par1 {unPar1 = 7}
instance AsOneItem (Par1 a) where
  type AsOneItemElement (Par1 a) = a

  matchOneItem =
    preview _Wrapped
  {-# INLINE matchOneItem #-}

-- | >>> preview _OneItem (MkSolo 7)
-- Just 7
--
-- >>> review _OneItem 7 :: Solo Int
-- MkSolo 7
instance AsOneItem (Solo a) where
  type AsOneItemElement (Solo a) = a

  matchOneItem (MkSolo x) = Just x
  {-# INLINE matchOneItem #-}