{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} module Data.Text1.AsSingle( AsSingle(..) ) where import Control.Category ( Category((.)) ) import Control.Lens ( uncons, prism, prism', Prism ) import Control.Monad ( (>=>) ) import Data.Char ( Char ) import Data.Either ( Either(Left, Right) ) import Data.Functor.Identity ( Identity(..) ) import Data.Maybe ( Maybe(..), maybe ) import qualified Data.List as List(null) import Data.List.NonEmpty(NonEmpty((:|))) import Data.Text(Text) import qualified Data.Text as Text(singleton, null) import qualified Data.Text.Lazy as LazyText(Text, singleton, null) class AsSingle s t a b | s -> a, t -> b, s b -> t, t a -> s where _Single :: Prism s t a b instance AsSingle [a] [a] a a where _Single :: p a (f a) -> p [a] (f [a]) _Single = (a -> [a]) -> ([a] -> Maybe a) -> Prism [a] [a] a a forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b prism' (a -> [a] -> [a] forall a. a -> [a] -> [a] :[]) (\case [a a] -> a -> Maybe a forall a. a -> Maybe a Just a a [a] _ -> Maybe a forall a. Maybe a Nothing) instance AsSingle Text Text Char Char where _Single :: p Char (f Char) -> p Text (f Text) _Single = (Char -> Text) -> (Text -> Maybe Char) -> Prism Text Text Char Char forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b prism' Char -> Text Text.singleton (Text -> Maybe (Char, Text) forall s a. Cons s s a a => s -> Maybe (a, s) uncons (Text -> Maybe (Char, Text)) -> ((Char, Text) -> Maybe Char) -> Text -> Maybe Char forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> \(Char h, Text t') -> if Text -> Bool Text.null Text t' then Char -> Maybe Char forall a. a -> Maybe a Just Char h else Maybe Char forall a. Maybe a Nothing) instance AsSingle LazyText.Text LazyText.Text Char Char where _Single :: p Char (f Char) -> p Text (f Text) _Single = (Char -> Text) -> (Text -> Maybe Char) -> Prism Text Text Char Char forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b prism' Char -> Text LazyText.singleton (Text -> Maybe (Char, Text) forall s a. Cons s s a a => s -> Maybe (a, s) uncons (Text -> Maybe (Char, Text)) -> ((Char, Text) -> Maybe Char) -> Text -> Maybe Char forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> \(Char h, Text t') -> if Text -> Bool LazyText.null Text t' then Char -> Maybe Char forall a. a -> Maybe a Just Char h else Maybe Char forall a. Maybe a Nothing) instance AsSingle (Maybe a) (Maybe b) a b where _Single :: p a (f b) -> p (Maybe a) (f (Maybe b)) _Single = (b -> Maybe b) -> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b prism b -> Maybe b forall a. a -> Maybe a Just (Either (Maybe b) a -> (a -> Either (Maybe b) a) -> Maybe a -> Either (Maybe b) a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe b -> Either (Maybe b) a forall a b. a -> Either a b Left Maybe b forall a. Maybe a Nothing) a -> Either (Maybe b) a forall a b. b -> Either a b Right) instance AsSingle (Identity a) (Identity b) a b where _Single :: p a (f b) -> p (Identity a) (f (Identity b)) _Single = (b -> Identity b) -> (Identity a -> Either (Identity b) a) -> Prism (Identity a) (Identity b) a b forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b prism b -> Identity b forall a. a -> Identity a Identity (a -> Either (Identity b) a forall a b. b -> Either a b Right (a -> Either (Identity b) a) -> (Identity a -> a) -> Identity a -> Either (Identity b) a forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Identity a -> a forall a. Identity a -> a runIdentity) instance AsSingle (NonEmpty a) (NonEmpty a) a a where _Single :: p a (f a) -> p (NonEmpty a) (f (NonEmpty a)) _Single = (a -> NonEmpty a) -> (NonEmpty a -> Maybe a) -> Prism (NonEmpty a) (NonEmpty a) a a forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b prism' (a -> [a] -> NonEmpty a forall a. a -> [a] -> NonEmpty a :|[]) (\(a h :| [a] t) -> if [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool List.null [a] t then a -> Maybe a forall a. a -> Maybe a Just a h else Maybe a forall a. Maybe a Nothing)