From ad3102e108562aa7c12e89991eb387cd3aa359ae Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 10 Feb 2021 18:04:12 -0500
Subject: Add boolean and logging pipeline operators

---
 Alpha.hs   | 35 +++++++++++++++++++++++++++--------
 Biz/Log.hs | 15 +++++++++++++++
 2 files changed, 42 insertions(+), 8 deletions(-)

diff --git a/Alpha.hs b/Alpha.hs
index 697f096..8fdca51 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -42,12 +42,17 @@ module Alpha
     (<%),
     (%>),
 
-    -- * inding
+    -- * Binding
     bind,
     (+>),
 
     -- * Bool
     don't,
+    (?>),
+    (?<),
+    (?:),
+    (?.),
+    (?+),
 
     -- * Text
     tshow,
@@ -66,9 +71,6 @@ module Alpha
 
     -- * Data Validation
     require,
-
-    -- * Debugging tools
-    say,
   )
 where
 
@@ -85,10 +87,6 @@ import qualified Prelude
 list :: a -> [a]
 list a = [a]
 
--- | Debugging printf
-say :: Text -> IO ()
-say = putText
-
 -- | Composition
 compose :: (a -> b) -> (b -> c) -> (a -> c)
 compose f g x = g (f x)
@@ -163,6 +161,27 @@ a +> b = a Prelude.>>= b
 
 infixl 1 +>
 
+-- | If-then-else. wutcol
+(?:) :: Bool -> (Bool -> p, Bool -> p) -> p
+a ?: (f, g) = if a then f a else g a
+
+-- | Inverted if-then-else. wutdot
+(?.) :: Bool -> (Bool -> p, Bool -> p) -> p
+a ?. (g, f) = if a then f a else g a
+
+-- | Positive assertion. wutgar
+(?>) :: Bool -> (Bool -> Text -> a) -> Text -> a
+a ?> f = if a then f a else panic "wutgar failed"
+
+-- | Lisp-style cond. wutlus
+(?+) :: t -> [(t -> Bool, p)] -> p
+a ?+ ((p, v) : ls) = if p a then v else a ?+ ls
+_ ?+ [] = panic "wutlus: empty cond list"
+
+-- | Negative assertion. wutgal
+(?<) :: Bool -> (Bool -> Text -> a) -> Text -> a
+a ?< f = if not a then f a else panic "wutgal failed"
+
 -- | Removes newlines from text.
 chomp :: Text -> Text
 chomp = Text.filter (/= '\n')
diff --git a/Biz/Log.hs b/Biz/Log.hs
index a4d6253..8c7b043 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -11,6 +11,9 @@ module Biz.Log
     fail,
     -- Debugging
     mark,
+    -- Operators
+    (~&),
+    (~?),
     -- | Low-level
     msg,
     br,
@@ -56,3 +59,15 @@ mark label val =
   unsafePerformIO <| do
     msg Mark [label, tshow val]
     pure val
+
+-- | Pipelined version of 'mark'.
+--
+-- @
+-- mark label val = val ~| label
+-- @
+(~&) :: Show a => a -> Text -> a
+(~&) val label = mark label val
+
+-- | Conditional mark.
+(~?) :: Show a => a -> (a -> Bool) -> Text -> a
+(~?) val test label = if test val then mark label val else val
-- 
cgit v1.2.3