Add left-compose and text wrap utils

1 files changed, 15 insertions, 0 deletions

diff --git a/Alpha.hs b/Alpha.hs
index 5ced72d..568229e 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -25,6 +25,7 @@ module Alpha
     -- * Composing
     compose,
     (.>),
+    (<.),
 
     -- * Applying
     (<|),
@@ -43,6 +44,7 @@ module Alpha
     lchomp,
     joinWith,
     CanSnakeCase (snake),
+    wrap,
 
     -- * String
     capitalize,
@@ -148,3 +150,16 @@ lowercase str = [Char.toLower c | c <- str]
 require :: Text -> Maybe a -> a
 require _ (Just x) = x
 require s Nothing = panic <| s <> " not found"
+
+-- | Wrap text at the given limit.
+wrap :: Int -> Text -> Text
+wrap lim = Text.unwords . wrap_ 0 . Text.words
+  where
+    wrap_ :: Int -> [Text] -> [Text]
+    wrap_ _ [] = []
+    wrap_ pos (w:ws)
+      | pos == 0 = w : (wrap_ (pos + lw) ws)
+      | pos + lw + 1 > lim = wrap_ 0 (Text.cons '\n' w : ws)
+      | otherwise = [w] ++ wrap_ (pos + lw + 1) ws
+      where
+        lw = Text.length w