one-0.0.1: src/Control/One/AsOne.hs

{-# 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 #-}