{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Headroom.Data.Text
Description : Additional utilities for text manipulation
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module containing bunch of useful functions for working with text.
-}

module Headroom.Data.Text
  ( read
  , commonLinesPrefix
  , replaceFirst
    -- * Working with text lines
  , mapLines
  , mapLinesF
  , fromLines
  , toLines
  )
where

import           RIO
import qualified RIO.Text                           as T
import qualified RIO.Text.Partial                   as TP


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Similar to 'T.commonPrefixes', but tries to find common prefix for all
-- lines in given text.
--
-- >>> commonLinesPrefix "-- first\n-- second\n-- third"
-- Just "-- "
commonLinesPrefix :: Text
                  -- ^ lines of text to find prefix for
                  -> Maybe Text
                  -- ^ found longest common prefixs
commonLinesPrefix :: Text -> Maybe Text
commonLinesPrefix Text
text = [Text] -> Maybe Text -> Maybe Text
go (Text -> [Text]
toLines Text
text) Maybe Text
forall a. Maybe a
Nothing
 where
  go :: [Text] -> Maybe Text -> Maybe Text
go []       Maybe Text
acc        = Maybe Text
acc
  go (Text
x : [Text]
xs) Maybe Text
Nothing    = [Text] -> Maybe Text -> Maybe Text
go [Text]
xs (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x)
  go (Text
x : [Text]
xs) (Just Text
acc) = case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
acc of
    Just (Text
n, Text
_, Text
_) -> [Text] -> Maybe Text -> Maybe Text
go [Text]
xs (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n)
    Maybe (Text, Text, Text)
_              -> Maybe Text
forall a. Maybe a
Nothing


-- | Similar to 'T.replace', but replaces only very first occurence of pattern.
--
-- >>> replaceFirst ":" "/" "a : b : c"
-- "a / b : c"
replaceFirst :: Text -> Text -> Text -> Text
replaceFirst :: Text -> Text -> Text -> Text
replaceFirst Text
ptrn Text
substitution Text
text | Text -> Bool
T.null Text
ptrn Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
back = Text
text
                                    | Bool
otherwise                  = Text
processed
 where
  (Text
front, Text
back) = Text -> Text -> (Text, Text)
TP.breakOn Text
ptrn Text
text
  processed :: Text
processed     = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
front, Text
substitution, Int -> Text -> Text
T.drop (Text -> Int
T.length Text
ptrn) Text
back]


-- | Maps given function over individual lines of the given text.
--
-- >>> mapLines ("T: " <>) "foo zz\nbar"
-- "T: foo zz\nT: bar"
mapLines :: (Text -> Text)
         -- ^ function to map over individual lines
         -> Text
         -- ^ input text
         -> Text
         -- ^ resulting text
mapLines :: (Text -> Text) -> Text -> Text
mapLines Text -> Text
fn = (Text -> Maybe Text) -> Text -> Text
forall (t :: * -> *).
Foldable t =>
(Text -> t Text) -> Text -> Text
mapLinesF (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text
fn)


-- | Similar to 'mapLines', but the mapping function returns 'Foldable', which
-- gives some more control over outcome. After mapping over all individual
-- lines, results are folded and concatenated, which allows for example
-- filtering out some lines.
--
-- >>> mapLinesF (\l -> if l == "bar" then Nothing else Just l) "foo\nbar"
-- "foo"
mapLinesF :: Foldable t
          => (Text -> t Text)
          -- ^ function to map over inividual lines
          -> Text
          -- ^ input text
          -> Text
          -- ^ resulting text
mapLinesF :: (Text -> t Text) -> Text -> Text
mapLinesF Text -> t Text
f = [Text] -> Text
fromLines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t Text -> [Text]) -> [t Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([t Text] -> [[Text]]) -> (Text -> [t Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [t Text]
go ([Text] -> [t Text]) -> (Text -> [Text]) -> Text -> [t Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
toLines
 where
  go :: [Text] -> [t Text]
go []       = []
  go (Text
x : [Text]
xs) = Text -> t Text
f Text
x t Text -> [t Text] -> [t Text]
forall a. a -> [a] -> [a]
: [Text] -> [t Text]
go [Text]
xs


-- | Same as 'readMaybe', but takes 'Text' as input instead of 'String'.
--
-- >>> read "123" :: Maybe Int
-- Just 123
read :: Read a
     => Text
     -- ^ input text to parse
     -> Maybe a
     -- ^ parsed value
read :: Text -> Maybe a
read = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack


-- | Similar to 'T.unlines', but does not automatically adds @\n@ at the end
-- of the text. Advantage is that when used together with 'toLines', it doesn't
-- ocassionaly change the newlines ad the end of input text:
--
-- >>> fromLines . toLines $ "foo\nbar"
-- "foo\nbar"
--
-- >>> fromLines . toLines $ "foo\nbar\n"
-- "foo\nbar\n"
--
-- Other examples:
--
-- >>> fromLines []
-- ""
--
-- >>> fromLines ["foo"]
-- "foo"
--
-- >>> fromLines ["first", "second"]
-- "first\nsecond"
--
-- >>> fromLines ["first", "second", ""]
-- "first\nsecond\n"
fromLines :: [Text]
          -- ^ lines to join
          -> Text
          -- ^ text joined from individual lines
fromLines :: [Text] -> Text
fromLines = Text -> [Text] -> Text
T.intercalate Text
"\n"


-- | Similar to 'T.lines', but does not drop trailing newlines from output.
-- Advantage is that when used together with 'fromLines', it doesn't ocassionaly
-- change the newlines ad the end of input text:
--
-- >>> fromLines . toLines $ "foo\nbar"
-- "foo\nbar"
--
-- >>> fromLines . toLines $ "foo\nbar\n"
-- "foo\nbar\n"
--
-- Other examples:
--
-- >>> toLines ""
-- []
--
-- >>> toLines "first\nsecond"
-- ["first","second"]
--
-- >>> toLines "first\nsecond\n"
-- ["first","second",""]
toLines :: Text
        -- ^ text to break into lines
        -> [Text]
        -- ^ lines of input text
toLines :: Text -> [Text]
toLines Text
input | Text -> Bool
T.null Text
input = []
              | Bool
otherwise    = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
input