{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.String
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- String manipulation utilities

module Yi.String (isBlank,
                  chomp,
                  capitalize,
                  capitalizeFirst,
                  dropSpace,
                  fillText,
                  onLines,
                  mapLines,
                  lines',
                  unlines',
                  padLeft, padRight,
                  commonTPrefix,
                  commonTPrefix',
                  listify,
                  showT,
                  overInit, overTail
                 ) where

import           Data.Char   (isAlphaNum, isSpace, toLower, toUpper)
import           Data.List   (isSuffixOf)
import           Data.Maybe  (fromMaybe)
import           Data.Monoid ((<>))
import qualified Data.Text   as T (Text, break, commonPrefixes, empty,
                                   intercalate, pack, splitAt, splitOn, toUpper)
import qualified Yi.Rope     as R (YiString, all, cons, head, init, intercalate,
                                   last, length, lines', snoc, tail, unwords,
                                   withText, words)

-- | Helper that shows then packs the 'Text', for all those cases
-- where we use 'show'.
showT :: Show a => a -> T.Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | This is kind of like the default Show instance for lists except
-- over 'T.Text'. It does not leave the elements in extra quotes and
-- should not be attempted to be 'show'n and 'read' back.
listify :: [R.YiString] -> R.YiString
listify :: [YiString] -> YiString
listify [YiString]
t = Char
'[' Char -> YiString -> YiString
`R.cons` YiString -> [YiString] -> YiString
R.intercalate YiString
", " [YiString]
t YiString -> Char -> YiString
`R.snoc` Char
']'

-- | Works by resupplying the found prefix back into the list,
-- eventually either finding the prefix or not matching.
commonTPrefix :: [T.Text] -> Maybe T.Text
commonTPrefix :: [Text] -> Maybe Text
commonTPrefix (Text
x:Text
y:[Text]
xs) = case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
y of
  Maybe (Text, Text, Text)
Nothing -> Maybe Text
forall a. Maybe a
Nothing
  Just (Text
p, Text
_, Text
_) -> [Text] -> Maybe Text
commonTPrefix (Text
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
commonTPrefix [Text
x] = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
commonTPrefix [Text]
_ = Maybe Text
forall a. Maybe a
Nothing

-- | Like 'commonTPrefix' but returns empty text on failure.
commonTPrefix' :: [T.Text] -> T.Text
commonTPrefix' :: [Text] -> Text
commonTPrefix' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
commonTPrefix

capitalize :: String -> String
capitalize :: String -> String
capitalize [] = []
capitalize (Char
c:String
cs) = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cs

capitalizeFirst :: R.YiString -> R.YiString
capitalizeFirst :: YiString -> YiString
capitalizeFirst = (Text -> Text) -> YiString -> YiString
R.withText Text -> Text
go
  where
    go :: Text -> Text
go Text
x = case (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isAlphaNum Text
x of
      (Text
f, Text
b) -> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Int -> Text -> (Text, Text)
T.splitAt Int
1 Text
b of
        (Text
h, Text
hs) -> Text -> Text
T.toUpper Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hs

-- | Remove any trailing strings matching /irs/ (input record separator)
-- from input string. Like perl's chomp(1).
chomp :: String -> String -> String
chomp :: String -> String -> String
chomp String
irs String
st
    | String
irs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
st
    = let st' :: String
st' = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
irs) (String -> String
forall a. [a] -> [a]
reverse String
st) in String -> String -> String
chomp String
irs String
st'
    | Bool
otherwise = String
st
{-# INLINE chomp #-}


-- | Trim spaces at beginning /and/ end
dropSpace :: String -> String
dropSpace :: String -> String
dropSpace = let f :: String -> String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace in String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f

isBlank :: R.YiString -> Bool
isBlank :: YiString -> Bool
isBlank = (Char -> Bool) -> YiString -> Bool
R.all Char -> Bool
isSpace

-- | Fills lines up to the given length, splitting the text up if
-- necessary.
fillText :: Int -> R.YiString -> [R.YiString]
fillText :: Int -> YiString -> [YiString]
fillText Int
margin = ([YiString] -> YiString) -> [[YiString]] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
map ([YiString] -> YiString
R.unwords ([YiString] -> YiString)
-> ([YiString] -> [YiString]) -> [YiString] -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> [YiString]
forall a. [a] -> [a]
reverse) ([[YiString]] -> [YiString])
-> (YiString -> [[YiString]]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [YiString] -> [YiString] -> [[YiString]]
fill Int
0 [] ([YiString] -> [[YiString]])
-> (YiString -> [YiString]) -> YiString -> [[YiString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> [YiString]
R.words
  where
    fill :: Int -> [YiString] -> [YiString] -> [[YiString]]
fill Int
_ [YiString]
acc [] = [[YiString]
acc]
    fill Int
n [YiString]
acc (YiString
w:[YiString]
ws)
      | Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ YiString -> Int
R.length YiString
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
margin = [YiString]
acc [YiString] -> [[YiString]] -> [[YiString]]
forall a. a -> [a] -> [a]
: Int -> [YiString] -> [YiString] -> [[YiString]]
fill (YiString -> Int
R.length YiString
w) [YiString
w] [YiString]
ws
      | Bool
otherwise = Int -> [YiString] -> [YiString] -> [[YiString]]
fill (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ YiString -> Int
R.length YiString
w) (YiString
wYiString -> [YiString] -> [YiString]
forall a. a -> [a] -> [a]
:[YiString]
acc) [YiString]
ws

-- | @overInit f@ runs f over the 'R.init' of the input if possible,
-- preserving the 'R.last' element as-is. If given a string with
-- length ≤ 1, it effectively does nothing.
--
-- Also see 'overTail'.
overInit :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString
overInit :: (YiString -> YiString) -> YiString -> YiString
overInit YiString -> YiString
f YiString
t = case (YiString -> Maybe YiString
R.init YiString
t, YiString -> Maybe Char
R.last YiString
t) of
  (Just YiString
xs, Just Char
x) -> YiString -> YiString
f YiString
xs YiString -> Char -> YiString
`R.snoc` Char
x
  (Maybe YiString, Maybe Char)
_ -> YiString
t

-- | @overInit f@ runs f over the 'R.tail' of the input if possible,
-- preserving the 'R.head' element as-is. If given a string with
-- length ≤ 1, it effectively does nothing.
--
-- Also see 'overInit'.
overTail :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString
overTail :: (YiString -> YiString) -> YiString -> YiString
overTail YiString -> YiString
f YiString
t = case (YiString -> Maybe Char
R.head YiString
t, YiString -> Maybe YiString
R.tail YiString
t) of
  (Just Char
x, Just YiString
xs) -> Char
x Char -> YiString -> YiString
`R.cons` YiString -> YiString
f YiString
xs
  (Maybe Char, Maybe YiString)
_ -> YiString
t

-- | Inverse of 'lines''. In contrast to 'Prelude.unlines', this does
-- not add an empty line at the end.
unlines' :: [T.Text] -> T.Text
unlines' :: [Text] -> Text
unlines' = Text -> [Text] -> Text
T.intercalate Text
"\n"

-- | Split a Text in lines. Unlike 'Prelude.lines', this does not
-- remove any empty line at the end.
lines' :: T.Text -> [T.Text]
lines' :: Text -> [Text]
lines' = Text -> Text -> [Text]
T.splitOn Text
"\n"

-- | A helper function for creating functions suitable for
-- 'modifySelectionB' and 'modifyRegionB'.
-- To be used when the desired function should map across
-- the lines of a region.
mapLines :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString
mapLines :: (YiString -> YiString) -> YiString -> YiString
mapLines YiString -> YiString
f = ([YiString] -> [YiString]) -> YiString -> YiString
onLines (([YiString] -> [YiString]) -> YiString -> YiString)
-> ([YiString] -> [YiString]) -> YiString -> YiString
forall a b. (a -> b) -> a -> b
$ (YiString -> YiString) -> [YiString] -> [YiString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> YiString
f

onLines :: ([R.YiString] -> [R.YiString]) -> R.YiString -> R.YiString
onLines :: ([YiString] -> [YiString]) -> YiString -> YiString
onLines [YiString] -> [YiString]
f = [YiString] -> YiString
forall a. Monoid a => [a] -> a
mconcat ([YiString] -> YiString)
-> (YiString -> [YiString]) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> [YiString]
f ([YiString] -> [YiString])
-> (YiString -> [YiString]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> [YiString]
R.lines'

padLeft, padRight :: Int -> String -> String
padLeft :: Int -> String -> String
padLeft Int
n [] = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
padLeft Int
n (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
padLeft (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
xs

padRight :: Int -> String -> String
padRight Int
n = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
padLeft Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse