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