commit 1149fa76f683442b27d12b822661b1043fe8317b
Author: Robert Russell <robert@rr3.xyz>
Date: Sun, 4 May 2025 00:48:11 -0700
Initial commit
Diffstat:
5 files changed, 287 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,3 @@
+.stack-work
+*.lock
+*.cabal
diff --git a/LICENSE b/LICENSE
@@ -0,0 +1,15 @@
+ISC License
+
+Copyright (c) 2025, Robert Russell
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+\ No newline at end of file
diff --git a/package.yaml b/package.yaml
@@ -0,0 +1,35 @@
+name: lude
+version: 0.1.0.0
+author: "Robert Russell"
+license: ISC
+
+ghc-options:
+ - -Wall
+ - -Wno-name-shadowing
+ - -Wno-missing-signatures
+
+default-extensions:
+ - NoImplicitPrelude
+ - BangPatterns
+ - TypeFamilies
+ - TypeOperators
+#- DuplicateRecordFields
+#- NoFieldSelectors
+#- OverloadedRecordDot
+#- BlockArguments
+#- LambdaCase
+#- MultiWayIf
+#- OverloadedStrings
+#- ScopedTypeVariables
+#- FlexibleInstances
+#- MultiParamTypeClasses
+#- UndecidableInstances
+
+dependencies:
+ - base
+ - bytestring
+ - text
+ - mtl
+
+library:
+ source-dirs: src
diff --git a/src/Lude.hs b/src/Lude.hs
@@ -0,0 +1,232 @@
+module Lude (
+ -- Function
+ const,
+ fix,
+ flip,
+ ($),
+ ($!),
+ (&),
+ (&!),
+ -- Category
+ Category ((.)),
+ identity,
+ (<<),
+ (>>),
+ -- Functor
+ Functor,
+ void,
+ Const (Const, getConst),
+ Identity (Identity, runIdentity),
+ map,
+ ($^),
+ for,
+ (^&),
+ flap,
+ (^$),
+ flor,
+ (&^),
+ (<<^),
+ (^>>),
+ (^<<),
+ (>>^),
+ -- Applicative
+ Applicative (pure),
+ pass,
+ ap,
+ (^$^),
+ plug,
+ (^&^),
+ (^<<^),
+ (^>>^),
+ -- Monad
+ Monad,
+ map',
+ ($!^),
+ for',
+ (^&!),
+ flap',
+ (^$!),
+ flor',
+ (&!^),
+ ap',
+ (^$!^),
+ plug',
+ (^&!^),
+) where
+
+import Control.Applicative (Applicative (liftA2, pure, (<*>)), (<**>))
+import Control.Category (Category (id, (.)))
+import Control.Monad (Monad ((>>=)))
+import Data.Foldable (Foldable)
+import Data.Function (const, fix, flip)
+import Data.Functor (Functor (fmap), void)
+import Data.Functor.Const (Const (Const, getConst))
+import Data.Functor.Identity (Identity (Identity, runIdentity))
+import Data.Maybe (Maybe)
+import Data.Traversable (Traversable (sequenceA))
+
+--------------------------------------------------------------------------------
+-- Function
+
+-- Note how the associativities and (relative) precedences differ with the
+-- infix operators in Data.Function.
+infixl 0 &, &!
+infixl 1 $, $!
+
+-- | Function application.
+($) :: (a -> b) -> a -> b
+f $ x = f x
+
+-- | Strict function application.
+($!) :: (a -> b) -> a -> b
+f $! !x = f x
+
+-- Flipped function application, or "pipe".
+(&) :: a -> (a -> b) -> b
+x & f = f x
+
+-- Strict flipped function application, or "pipe".
+(&!) :: a -> (a -> b) -> b
+!x &! f = f x
+
+--------------------------------------------------------------------------------
+-- Category
+
+infixr 2 <<, >>
+
+-- | The identity morphism.
+--
+-- This is just a renamed version of @Control.Category.id@.
+identity :: (Category v) => v a a
+identity = id
+
+-- | Right-to-left composition.
+--
+-- This operator is right associative to exploit laziness in the case where
+-- the outer function doesn't need its argument:
+--
+-- > (const x << (f << g)) y ---> const x ((f << g) y) ---> x
+--
+-- Note that @f << g@ is never evaluated.
+(<<) :: (Category v) => v b c -> v a b -> v a c
+(<<) = (.)
+
+-- | Left-to-right composition.
+(>>) :: (Category v) => v a b -> v b c -> v a c
+(>>) = flip (.)
+
+--------------------------------------------------------------------------------
+-- Functor
+
+infixl 0 ^&, &^
+infixl 1 $^, ^$
+infixr 2 <<^, ^>>, ^<<, >>^
+
+-- | The action of a functor on a function.
+map, ($^) :: (Functor f) => (a -> b) -> f a -> f b
+map = fmap
+($^) = map
+
+-- | The action of a functor on a function, flipped.
+--
+-- With the BlockArguments extension, expressions like "@for xs \\x -> ...@"
+-- look like imperative for-loops, hence the name "for".
+for, (^&) :: (Functor f) => f a -> (a -> b) -> f b
+for = flip map
+(^&) = for
+
+-- | Application of a function in a functor to a pure value.
+flap, (^$) :: (Functor f) => f (a -> b) -> a -> f b
+flap f a = f ^& ($ a)
+(^$) = flap
+
+-- | Flipped application of a function in a functor to a pure value.
+flor, (&^) :: (Functor f) => a -> f (a -> b) -> f b
+flor = flip flap
+(&^) = flor
+
+-- | Right-to-left composition with the first function in a functor.
+(<<^) :: (Functor f, Category v) => v b c -> f (v a b) -> f (v a c)
+g <<^ f = (g <<) $^ f
+
+-- | Left-to-right composition with the first function in a functor.
+(^>>) :: (Functor f, Category v) => f (v a b) -> v b c -> f (v a c)
+f ^>> g = f ^& (>> g)
+
+-- | Right-to-left composition with the second function in a functor.
+(^<<) :: (Functor f, Category v) => f (v b c) -> v a b -> f (v a c)
+g ^<< f = g ^& (<< f)
+
+-- | Left-to-right composition with the second function in a functor.
+(>>^) :: (Functor f, Category v) => v a b -> f (v b c) -> f (v a c)
+f >>^ g = (f >>) $^ g
+
+-- TODO: *^, ^*
+
+--------------------------------------------------------------------------------
+-- Applicative
+
+infixl 0 ^&^
+infixl 1 ^$^
+infixr 2 ^<<^, ^>>^
+
+-- | An alias for @pure ()@.
+pass :: (Applicative f) => f ()
+pass = pure ()
+
+-- | Application in an applicative functor.
+ap, (^$^) :: (Applicative f) => f (a -> b) -> f a -> f b
+ap = (<*>)
+(^$^) = ap
+
+-- | Flipped application in an applicative functor (with effects resolved as
+-- they appear, left-to-right).
+plug, (^&^) :: (Applicative f) => f a -> f (a -> b) -> f b
+plug = (<**>)
+(^&^) = plug
+
+-- TODO: document
+(^<<^) :: (Applicative f, Category v) => f (v b c) -> f (v a b) -> f (v a c)
+(^<<^) = liftA2 (<<)
+
+-- TODO: document
+(^>>^) :: (Applicative f, Category v) => f (v a b) -> f (v b c) -> f (v a c)
+(^>>^) = liftA2 (>>)
+
+-- TODO: "semicolons"
+
+--------------------------------------------------------------------------------
+-- Monad
+
+infixl 0 ^&!, &!^, ^&!^
+infixl 1 $!^, ^$!, ^$!^
+
+map', ($!^) :: (Monad m) => (a -> b) -> m a -> m b
+map' f mx = mx >>= \x -> pure $! f x
+($!^) = map'
+
+for', (^&!) :: (Monad m) => m a -> (a -> b) -> m b
+for' = flip map'
+(^&!) = for
+
+flap', (^$!) :: (Monad m) => m (a -> b) -> a -> m b
+flap' mf x = mf >>= \f -> pure $! f x
+(^$!) = flap'
+
+flor', (&!^) :: (Monad m) => a -> m (a -> b) -> m b
+flor' = flip flap'
+(&!^) = flor'
+
+ap', (^$!^) :: (Monad m) => m (a -> b) -> m a -> m b
+ap' mf mx = do
+ f <- mf
+ x <- mx
+ pure $! f x
+(^$!^) = ap'
+
+plug', (^&!^) :: (Monad m) => m a -> m (a -> b) -> m b
+plug' mx mf = do
+ x <- mx
+ f <- mf
+ pure $! f x
+(^&!^) = plug'
diff --git a/stack.yaml b/stack.yaml
@@ -0,0 +1 @@
+resolver: lts-23.19
