{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}

module Data.Text1.AsSingle(
  AsSingle(..)
) where

import Control.Category ( Category(id, (.)) )
import Control.Lens ( uncons, prism', Prism' )
import Control.Monad ( (>=>) )
import Data.Char ( Char )
import Data.Functor.Identity ( Identity(..) )
import Data.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 c a | c -> a where
  _Single :: Prism' c a

instance AsSingle [a] a where
  _Single :: p a (f a) -> p [a] (f [a])
_Single =
    (a -> [a]) -> ([a] -> Maybe a) -> Prism' [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 Char where
  _Single :: p Char (f Char) -> p Text (f Text)
_Single =
    (Char -> Text) -> (Text -> Maybe Char) -> Prism' Text 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 Char where
  _Single :: p Char (f Char) -> p Text (f Text)
_Single =
    (Char -> Text) -> (Text -> Maybe Char) -> Prism' Text 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) a where
  _Single :: p a (f a) -> p (Maybe a) (f (Maybe a))
_Single =
    (a -> Maybe a) -> (Maybe a -> Maybe a) -> Prism' (Maybe a) a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      a -> Maybe a
forall a. a -> Maybe a
Just
      Maybe a -> Maybe a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance AsSingle (Identity a) a where
  _Single :: p a (f a) -> p (Identity a) (f (Identity a))
_Single =
    (a -> Identity a)
-> (Identity a -> Maybe a) -> Prism' (Identity a) a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      a -> Identity a
forall a. a -> Identity a
Identity
      (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Identity a -> a) -> Identity a -> Maybe 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) a where
  _Single :: p a (f a) -> p (NonEmpty a) (f (NonEmpty a))
_Single =
    (a -> NonEmpty a)
-> (NonEmpty a -> Maybe a) -> Prism' (NonEmpty 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)