{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.NonEmptyText
    ( NonEmptyText

      -- * Creation
    , new
    , singleton
    , toText
    , fromText

      -- * Basic interface
    , cons
    , snoc
    , uncons
    , unsnoc
    , append
    , Data.NonEmptyText.head
    , Data.NonEmptyText.last
    , Data.NonEmptyText.tail
    , Data.NonEmptyText.init
    , Data.NonEmptyText.length
    , Data.NonEmptyText.map
    , isSingleton

    -- * Folds
    , Data.NonEmptyText.foldl1
    , Data.NonEmptyText.foldl1'
    ) where

import Control.DeepSeq (NFData)
import Data.Bifunctor ( bimap )
import qualified Data.Text as Text
import GHC.Generics (Generic)

data NonEmptyText =
  NonEmptyText Char Text.Text
  deriving (NonEmptyText -> NonEmptyText -> Bool
(NonEmptyText -> NonEmptyText -> Bool)
-> (NonEmptyText -> NonEmptyText -> Bool) -> Eq NonEmptyText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonEmptyText -> NonEmptyText -> Bool
== :: NonEmptyText -> NonEmptyText -> Bool
$c/= :: NonEmptyText -> NonEmptyText -> Bool
/= :: NonEmptyText -> NonEmptyText -> Bool
Eq, Eq NonEmptyText
Eq NonEmptyText
-> (NonEmptyText -> NonEmptyText -> Ordering)
-> (NonEmptyText -> NonEmptyText -> Bool)
-> (NonEmptyText -> NonEmptyText -> Bool)
-> (NonEmptyText -> NonEmptyText -> Bool)
-> (NonEmptyText -> NonEmptyText -> Bool)
-> (NonEmptyText -> NonEmptyText -> NonEmptyText)
-> (NonEmptyText -> NonEmptyText -> NonEmptyText)
-> Ord NonEmptyText
NonEmptyText -> NonEmptyText -> Bool
NonEmptyText -> NonEmptyText -> Ordering
NonEmptyText -> NonEmptyText -> NonEmptyText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NonEmptyText -> NonEmptyText -> Ordering
compare :: NonEmptyText -> NonEmptyText -> Ordering
$c< :: NonEmptyText -> NonEmptyText -> Bool
< :: NonEmptyText -> NonEmptyText -> Bool
$c<= :: NonEmptyText -> NonEmptyText -> Bool
<= :: NonEmptyText -> NonEmptyText -> Bool
$c> :: NonEmptyText -> NonEmptyText -> Bool
> :: NonEmptyText -> NonEmptyText -> Bool
$c>= :: NonEmptyText -> NonEmptyText -> Bool
>= :: NonEmptyText -> NonEmptyText -> Bool
$cmax :: NonEmptyText -> NonEmptyText -> NonEmptyText
max :: NonEmptyText -> NonEmptyText -> NonEmptyText
$cmin :: NonEmptyText -> NonEmptyText -> NonEmptyText
min :: NonEmptyText -> NonEmptyText -> NonEmptyText
Ord, NonEmptyText -> ()
(NonEmptyText -> ()) -> NFData NonEmptyText
forall a. (a -> ()) -> NFData a
$crnf :: NonEmptyText -> ()
rnf :: NonEmptyText -> ()
NFData, (forall x. NonEmptyText -> Rep NonEmptyText x)
-> (forall x. Rep NonEmptyText x -> NonEmptyText)
-> Generic NonEmptyText
forall x. Rep NonEmptyText x -> NonEmptyText
forall x. NonEmptyText -> Rep NonEmptyText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NonEmptyText -> Rep NonEmptyText x
from :: forall x. NonEmptyText -> Rep NonEmptyText x
$cto :: forall x. Rep NonEmptyText x -> NonEmptyText
to :: forall x. Rep NonEmptyText x -> NonEmptyText
Generic)

instance Show NonEmptyText where
  show :: NonEmptyText -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String)
-> (NonEmptyText -> Text) -> NonEmptyText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
toText

instance Semigroup NonEmptyText where
  NonEmptyText
x <> :: NonEmptyText -> NonEmptyText -> NonEmptyText
<> NonEmptyText
y = NonEmptyText -> NonEmptyText -> NonEmptyText
append NonEmptyText
x NonEmptyText
y

-- | /O(1)/ Create a new 'NonEmptyText'
--
-- >>> new 'h' "ello world"
-- "hello world"
--
new :: Char -> Text.Text -> NonEmptyText
new :: Char -> Text -> NonEmptyText
new = Char -> Text -> NonEmptyText
NonEmptyText


-- | /O(1)/ Convert a character into a 'NonEmptyText'.
--
-- >>> singleton 'a'
-- "a"
--
singleton :: Char -> NonEmptyText
singleton :: Char -> NonEmptyText
singleton = (Char -> Text -> NonEmptyText) -> Text -> Char -> NonEmptyText
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Text -> NonEmptyText
NonEmptyText Text
Text.empty


-- | /O(1)/ Check if the string is composed of only one character
isSingleton :: NonEmptyText -> Bool
isSingleton :: NonEmptyText -> Bool
isSingleton = Text -> Bool
Text.null (Text -> Bool) -> (NonEmptyText -> Text) -> NonEmptyText -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Text
forall a b. (a, b) -> b
snd ((Char, Text) -> Text)
-> (NonEmptyText -> (Char, Text)) -> NonEmptyText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> (Char, Text)
uncons


-- | /O(n)/ Prefixes the 'NonEmptyText' with one character
cons :: Char -> NonEmptyText -> NonEmptyText
cons :: Char -> NonEmptyText -> NonEmptyText
cons Char
h NonEmptyText
t = Char -> Text -> NonEmptyText
new Char
h (NonEmptyText -> Text
toText NonEmptyText
t)


-- | /O(n)/ Suffixes the 'NonEmptyText' with one character
snoc :: NonEmptyText -> Char -> NonEmptyText
snoc :: NonEmptyText -> Char -> NonEmptyText
snoc (NonEmptyText Char
h Text
t) Char
c = Char -> Text -> NonEmptyText
new Char
h (Text -> Char -> Text
Text.snoc Text
t Char
c)


-- | /O(n)/ Appends one 'NonEmptyText' to another
--
-- >>> append <$> fromText "hello," <*> fromText " world."
-- Just "hello, world."
append :: NonEmptyText -> NonEmptyText -> NonEmptyText
append :: NonEmptyText -> NonEmptyText -> NonEmptyText
append (NonEmptyText Char
h Text
t) = Char -> Text -> NonEmptyText
new Char
h (Text -> NonEmptyText)
-> (NonEmptyText -> Text) -> NonEmptyText -> NonEmptyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
Text.append Text
t (Text -> Text) -> (NonEmptyText -> Text) -> NonEmptyText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
toText


-- | /O(1)/ Return the first character and the rest of the 'NonEmptyText'
uncons :: NonEmptyText -> (Char, Text.Text)
uncons :: NonEmptyText -> (Char, Text)
uncons (NonEmptyText Char
h Text
t) = (Char
h, Text
t)


-- | /O(n)/ Return the beginning of the 'NonEmptyText', and its last character
unsnoc :: NonEmptyText -> (Text.Text, Char)
unsnoc :: NonEmptyText -> (Text, Char)
unsnoc (NonEmptyText Char
h Text
t) =
    case Text -> Maybe (Text, Char)
unsnocT Text
t of
        Maybe (Text, Char)
Nothing     -> (Text
Text.empty, Char
h)
        Just (Text
m, Char
e) -> (Char -> Text -> Text
Text.cons Char
h Text
m, Char
e)
  where
    unsnocT :: Text.Text -> Maybe (Text.Text, Char)
    unsnocT :: Text -> Maybe (Text, Char)
unsnocT Text
text = -- Some old version of Data.Text don't have unsnoc
        let n :: Int
n = Text -> Int
Text.length Text
text Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 in
        if Text -> Bool
Text.null Text
text
        then Maybe (Text, Char)
forall a. Maybe a
Nothing
        else (Text, Char) -> Maybe (Text, Char)
forall a. a -> Maybe a
Just (Int -> Text -> Text
Text.take Int
n Text
text, HasCallStack => Text -> Int -> Char
Text -> Int -> Char
Text.index Text
text Int
n)


-- | /O(1)/ Return the first of the 'NonEmptyText'
--
-- As opposed to 'Data.Text.head', this is guaranteed to succeed, as the
-- the text is never empty.
head :: NonEmptyText -> Char
head :: NonEmptyText -> Char
head (NonEmptyText Char
h Text
_) = Char
h
{-# INLINE Data.NonEmptyText.head #-}

-- | /O(1)/ Return the last character of the 'NonEmptyText'
--
-- This never fails.
last :: NonEmptyText -> Char
last :: NonEmptyText -> Char
last = (Text, Char) -> Char
forall a b. (a, b) -> b
snd ((Text, Char) -> Char)
-> (NonEmptyText -> (Text, Char)) -> NonEmptyText -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> (Text, Char)
unsnoc
{-# INLINE Data.NonEmptyText.last #-}


-- | /O(1)/ Return all characters of the 'NonEmptyText' but the first one
tail :: NonEmptyText -> Text.Text
tail :: NonEmptyText -> Text
tail (NonEmptyText Char
_ Text
t ) = Text
t
{-# INLINE Data.NonEmptyText.tail #-}


-- | /O(n)/ Return all character of the 'NonEmptyText' but the last one
init :: NonEmptyText -> Text.Text
init :: NonEmptyText -> Text
init = (Text, Char) -> Text
forall a b. (a, b) -> a
fst ((Text, Char) -> Text)
-> (NonEmptyText -> (Text, Char)) -> NonEmptyText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> (Text, Char)
unsnoc
{-# INLINE Data.NonEmptyText.init #-}

-- | /O(n)/ Return the length of the total 'NonEmptyText'.
length :: NonEmptyText -> Int
length :: NonEmptyText -> Int
length = (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (NonEmptyText -> Int) -> NonEmptyText -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length (Text -> Int) -> (NonEmptyText -> Text) -> NonEmptyText -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
Data.NonEmptyText.tail
{-# INLINE Data.NonEmptyText.length #-}

-- | /O(n)/ Convert to NonEmptyText to Text.
--
-- The 'Data.Text.Text' result is guaranteed to be non-empty. However, this is
-- not reflected in the type.
toText :: NonEmptyText -> Text.Text
toText :: NonEmptyText -> Text
toText = (Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
Text.cons ((Char, Text) -> Text)
-> (NonEmptyText -> (Char, Text)) -> NonEmptyText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> (Char, Text)
uncons


-- | /O(n)/ 'Data.NonEmptyText.map' @f@ @t@ is the 'NonEmptyText' obtained by applying @f@ to
-- each element of @t@.
map :: (Char -> Char) -> NonEmptyText -> NonEmptyText
map :: (Char -> Char) -> NonEmptyText -> NonEmptyText
map Char -> Char
f = (Char -> Text -> NonEmptyText) -> (Char, Text) -> NonEmptyText
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> NonEmptyText
new ((Char, Text) -> NonEmptyText)
-> (NonEmptyText -> (Char, Text)) -> NonEmptyText -> NonEmptyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> (Text -> Text) -> (Char, Text) -> (Char, Text)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Char -> Char
f ((Char -> Char) -> Text -> Text
Text.map Char -> Char
f) ((Char, Text) -> (Char, Text))
-> (NonEmptyText -> (Char, Text)) -> NonEmptyText -> (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> (Char, Text)
uncons
{-# INLINE Data.NonEmptyText.map #-}

-- | /O(n)/ Create a 'NonEmptyText' from 'Data.Text.Text'.
--
-- If the original text is empty, this will return 'Data.Maybe.Nothing'.
--
-- >>> fromText "hello"
-- Just "hello"
-- >>> fromText ""
-- Nothing
fromText :: Text.Text -> Maybe NonEmptyText
fromText :: Text -> Maybe NonEmptyText
fromText = ((Char, Text) -> NonEmptyText)
-> Maybe (Char, Text) -> Maybe NonEmptyText
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Text -> NonEmptyText) -> (Char, Text) -> NonEmptyText
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> NonEmptyText
NonEmptyText) (Maybe (Char, Text) -> Maybe NonEmptyText)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe NonEmptyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text.uncons

-- | /O(n)/ 'Data.NonEmptyText.foldl1' is a left associative fold with no base case, as we know the
-- text cannot be empty.
foldl1 :: (Char -> Char -> Char) -> NonEmptyText -> Char
foldl1 :: (Char -> Char -> Char) -> NonEmptyText -> Char
foldl1 Char -> Char -> Char
fn (NonEmptyText Char
h Text
t) = (Char -> Char -> Char) -> Char -> Text -> Char
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl Char -> Char -> Char
fn Char
h Text
t
{-# INLINE Data.NonEmptyText.foldl1 #-}

-- | /O(n)/ A strict version of 'Data.NonEmptyText.foldl1'.
foldl1' :: (Char -> Char -> Char) -> NonEmptyText -> Char
foldl1' :: (Char -> Char -> Char) -> NonEmptyText -> Char
foldl1' Char -> Char -> Char
fn (NonEmptyText Char
h Text
t) = (Char -> Char -> Char) -> Char -> Text -> Char
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' Char -> Char -> Char
fn Char
h Text
t
{-# INLINE Data.NonEmptyText.foldl1' #-}