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

{-|
Module      : Headroom.Data.TextExtra
Description : Additional utilities for text manipulation
Copyright   : (c) 2019-2020 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.TextExtra
  ( read
    -- * Working with text lines
  , mapLines
  , fromLines
  , toLines
  )
where

import           RIO
import qualified RIO.Text                      as T


-- | 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
         -- ^ result text
mapLines :: (Text -> Text) -> Text -> Text
mapLines Text -> Text
fn = [Text] -> Text
fromLines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
go ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
toLines
 where
  go :: [Text] -> [Text]
go []       = []
  go (Text
x : [Text]
xs) = Text -> Text
fn Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [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