{-# LANGUAGE Trustworthy #-}

-- |
-- Module      : Data.Text.Short.Partial
-- Copyright   : © Herbert Valerio Riedel 2018
-- License     : BSD3
--
-- Maintainer  : hvr@gnu.org
-- Stability   : stable
--
-- Partial functions vocabulary
--
-- This module provides common partial functions for operating on 'ShortText'.
--
-- The use of these functions is discouraged as they tend to be error-prone.
--
-- @since 0.1.2
module Data.Text.Short.Partial
    ( head
    , tail
    , init
    , last
    , index

    , foldl1
    , foldl1'
    , foldr1
    ) where

import           Data.Text.Short
import           Data.Text.Short.Internal
import           Prelude                  ()

-- | \(\mathcal{O}(1)\) Returns first character of a non-empty 'ShortText'
--
-- >>> head "abcd"
-- 'a'
--
-- __Note__: Will throw an 'error' exception for empty 'ShortText's.
-- Consider using the total functions 'uncons' or 'indexMaybe'
-- instead.
--
-- @since 0.1.2
head :: ShortText -> Char
head :: ShortText -> Char
head = Char
-> ((Char, ShortText) -> Char) -> Maybe (Char, ShortText) -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"head: empty ShortText") (Char, ShortText) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, ShortText) -> Char)
-> (ShortText -> Maybe (Char, ShortText)) -> ShortText -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Maybe (Char, ShortText)
uncons

-- | \(\mathcal{O}(n)\) Drop first character from non-empty 'ShortText'.
--
-- >>> tail "abcd"
-- "bcd"
--
-- __Note__: Will throw an 'error' exception for empty 'ShortText's.
-- Consider using the total functions 'uncons' or 'drop' instead.
--
-- @since 0.1.2
tail :: ShortText -> ShortText
tail :: ShortText -> ShortText
tail = ShortText
-> ((Char, ShortText) -> ShortText)
-> Maybe (Char, ShortText)
-> ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ShortText
forall a. HasCallStack => [Char] -> a
error [Char]
"tail: empty ShortText") (Char, ShortText) -> ShortText
forall a b. (a, b) -> b
snd (Maybe (Char, ShortText) -> ShortText)
-> (ShortText -> Maybe (Char, ShortText)) -> ShortText -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Maybe (Char, ShortText)
uncons

-- | \(\mathcal{O}(n)\) Drop last character from non-empty 'ShortText'.
--
-- >>> tail "abcd"
-- "bcd"
--
-- __Note__: Will throw an 'error' exception for empty 'ShortText's.
-- Consider using the total functions 'unsnoc' or 'dropEnd' instead.
--
-- @since 0.1.2
init :: ShortText -> ShortText
init :: ShortText -> ShortText
init = ShortText
-> ((ShortText, Char) -> ShortText)
-> Maybe (ShortText, Char)
-> ShortText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ShortText
forall a. HasCallStack => [Char] -> a
error [Char]
"init: empty ShortText") (ShortText, Char) -> ShortText
forall a b. (a, b) -> a
fst (Maybe (ShortText, Char) -> ShortText)
-> (ShortText -> Maybe (ShortText, Char)) -> ShortText -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Maybe (ShortText, Char)
unsnoc

-- | \(\mathcal{O}(1)\) Return last character from non-empty 'ShortText'.
--
-- >>> last "abcd"
-- 'd'
--
-- __Note__: Will throw an 'error' exception for empty 'ShortText's.
-- Consider using the total functions 'unsnoc' or 'indexEndMaybe'
-- instead.
--
-- @since 0.1.2
last :: ShortText -> Char
last :: ShortText -> Char
last = Char
-> ((ShortText, Char) -> Char) -> Maybe (ShortText, Char) -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"last: empty ShortText") (ShortText, Char) -> Char
forall a b. (a, b) -> b
snd (Maybe (ShortText, Char) -> Char)
-> (ShortText -> Maybe (ShortText, Char)) -> ShortText -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Maybe (ShortText, Char)
unsnoc

-- | \(\mathcal{O}(n)\) Retrieve \(i\)-th character (code-point)
--
-- >>> index "abcd" 1
-- 'b'
--
-- __Note__: Will throw an 'error' exception if index is out of
-- bounds.  Consider using the total functions 'indexMaybe' or
-- 'indexEndMaybe' instead.
--
-- @since 0.1.2
index :: ShortText -> Int -> Char
index :: ShortText -> Int -> Char
index ShortText
st Int
i = case ShortText -> Int -> Maybe Char
indexMaybe ShortText
st Int
i of
               Maybe Char
Nothing -> [Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"index: not within ShortText"
               Just Char
c  -> Char
c

-- $setup
-- >>> :set -XOverloadedStrings