{-# 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