summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-03-27 12:07:16 -0700
committerBen Sima <ben@bsima.me>2020-03-28 18:18:17 -0700
commit9f9dcf54c3adb45012dd01dfd8137764046c968f (patch)
tree46bc1295db4ccd87de7b58fc283424bdef67d09c
parent0bbc82c83043102b3ba1f1a8c1608e92c65ec225 (diff)
Add onomatopoeitic operators
It's easier to remember what operators do, and thus easier to write and read condens code, if they follow some symbolic pattern or visually represent the concept to which they map. This is in part inspired by hoon, in part by OCaml's operators. I'm not married to these operators specifically, but I think they are good so far.
-rw-r--r--Com/InfluencedByBooks/Core.hs4
-rw-r--r--Com/InfluencedByBooks/Move.hs4
-rw-r--r--Com/MusicMeetsComics/App.hs6
-rw-r--r--Com/MusicMeetsComics/Look/Typography.hs2
-rw-r--r--Com/Simatime/Alpha.hs54
5 files changed, 51 insertions, 19 deletions
diff --git a/Com/InfluencedByBooks/Core.hs b/Com/InfluencedByBooks/Core.hs
index 1a8bf6f..6984004 100644
--- a/Com/InfluencedByBooks/Core.hs
+++ b/Com/InfluencedByBooks/Core.hs
@@ -100,7 +100,7 @@ see m = div_ [ class_ "container mt-5" ]
NotAsked -> [ text "Initializing..." ]
Loading -> [ text "Loading..." ]
Failure err -> [ text err ]
- Success ps -> seePerson /@ ps
+ Success ps -> seePerson </ ps
]
seePerson :: Person -> View Action
@@ -115,7 +115,7 @@ seePerson person = div_ [ class_ "card" ]
]
, p_ [ class_ "card-text" ]
[ text $ ms $ _blurb person
- , ul_ [] $ seeBook /@ _books person
+ , ul_ [] $ seeBook </ _books person
]
]
]
diff --git a/Com/InfluencedByBooks/Move.hs b/Com/InfluencedByBooks/Move.hs
index 3baafc6..d6cb12e 100644
--- a/Com/InfluencedByBooks/Move.hs
+++ b/Com/InfluencedByBooks/Move.hs
@@ -20,12 +20,12 @@ move :: Action -> Model -> Effect Action Model
move Nop m = noEff m
move (HandleRoute u) m = m { uri = u } <# pure Nop
move (ChangeRoute u) m = m <# do pushURI u >> pure Nop
-move FetchPeople m = m <# (SetPeople /@ fetchPeople)
+move FetchPeople m = m <# (SetPeople </ fetchPeople)
move (SetPeople ps) m = noEff m { people = ps }
fetchPeople :: IO (WebData [Core.Person])
fetchPeople = do
- mjson <- contents /@ xhrByteString req
+ mjson <- contents </ xhrByteString req
case mjson of
Nothing -> pure $ Failure "could not read from server"
Just a -> pure
diff --git a/Com/MusicMeetsComics/App.hs b/Com/MusicMeetsComics/App.hs
index 7f5b47f..fa3b8e9 100644
--- a/Com/MusicMeetsComics/App.hs
+++ b/Com/MusicMeetsComics/App.hs
@@ -408,7 +408,7 @@ mediaInfo Nothing _ = text ""
mediaInfo (Just comic) lib = div_ [ class_ "media-info" ] [ info comic lib ]
appmenu :: View Action
-appmenu = aside_ [ id_ "appmenu" ] $ btn /@ links
+appmenu = aside_ [ id_ "appmenu" ] $ btn </ links
where
links = [ (discoverLink, "discover.svg", "discover")
, (homeLink, "save.svg", "library")
@@ -434,7 +434,7 @@ nocomics = div_ [ class_ "loading" ] [ text "error: no comics found" ]
shelf :: IsMediaObject o => MisoString -> [o] -> View Action
shelf title comics = div_ [ class_ "shelf" ]
[ div_ [ class_ "shelf-head" ] [ text title ]
- , ul_ [ class_ "shelf-body" ] $ thumbnail /@ comics
+ , ul_ [ class_ "shelf-body" ] $ thumbnail </ comics
]
discoverFooter :: View Action
@@ -654,7 +654,7 @@ chooseExperiencePage comic page model = template "choose-experience"
, main_ [ id_ "app-body" ]
[ h2_ [] [ text "Choose Your Musical Experience" ]
, p_ [] [ text experienceBlurb ]
- , ul_ [] $ li comic /@ experiences
+ , ul_ [] $ li comic </ experiences
]
, appmenu
, comicControls comic page model
diff --git a/Com/MusicMeetsComics/Look/Typography.hs b/Com/MusicMeetsComics/Look/Typography.hs
index 91e157a..bb9fc01 100644
--- a/Com/MusicMeetsComics/Look/Typography.hs
+++ b/Com/MusicMeetsComics/Look/Typography.hs
@@ -56,7 +56,7 @@ fontRoot :: Text
fontRoot = Assets.cdnEdge <> "/old-assets/fonts/eurostile/Eurostile"
fonts :: Css
-fonts = mconcat $ mkEuro /@
+fonts = mconcat $ mkEuro </
[ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal)
, ("LTStd-Bold.otf", OpenType, thicc <> norm)
, ("LTStd-Cn.otf", OpenType, slim <> norm)
diff --git a/Com/Simatime/Alpha.hs b/Com/Simatime/Alpha.hs
index 16d21e3..8f5a506 100644
--- a/Com/Simatime/Alpha.hs
+++ b/Com/Simatime/Alpha.hs
@@ -4,9 +4,13 @@ module Com.Simatime.Alpha
(
-- * Re-export Protolude
module X
- -- * General functions
- , (/@)
- , (/@@)
+ -- * Applying
+ , (<|)
+ , (|>)
+ -- * Mapping
+ , (/>)
+ , (</)
+ , (<//)
-- * Debugging tools
, say
-- * TODO: remove this
@@ -14,20 +18,48 @@ module Com.Simatime.Alpha
)
where
+import Data.Function ( (&) )
+import Data.Functor ( (<&>) )
+import Data.String
import Data.Text ( Text )
import qualified Prelude
import Protolude as X
-import Data.String
-- | Debugging printf
say :: Text -> IO ()
say msg = putStrLn msg
--- | Alias for map, fmap, <$>. Inspired by Mathematica.
-(/@) :: Functor f => (a -> b) -> f a -> f b
-(/@) = fmap
+-- $operators
+--
+-- Operators have a pattern to their characters
+--
+-- `|` normal function-level applications
+-- `/` indicates doing something inside a functor
+-- `<` and `>` indicate the direction in which values flow btw functions
+
+-- | Alias for map, fmap, <$>
+(</) :: Functor f => (a -> b) -> f a -> f b
+(</) = fmap
+
+-- | Double fmap. A function on the left goes "into" two functors
+-- (i.e. it goes "two levels deep"), applies the function to the inner
+-- values, then returns the result wrapped in the two functors.
+(<//) :: (Functor f0, Functor f1) => (a -> b) -> f0 (f1 a) -> f0 (f1 b)
+(<//) = fmap . fmap
+
+-- | Normal function application. Do the right side, then pass the
+-- return value to the function on the left side.
+(<|) :: (a -> b) -> a -> b
+(<|) = ($)
+infixr 0 <|
+
+-- | Reverse function application. Do the left side, then pass the
+-- return value to the function on the right side.
+(|>) :: a -> (a -> b) -> b
+(|>) = (&)
--- | Double fmap.
--- (/@@) :: (Functor f1, Functor f2) => f1 (a -> b) -> f1 (f2 a) -> f1 (f2 b)
-(/@@) :: (Functor f0, Functor f1) => (a -> b) -> f0 (f1 a) -> f0 (f1 b)
-(/@@) = fmap . fmap
+-- | Alias for <&>. Can be read as "and then". Basically does into a
+-- functor, does some computation, then returns the same kind of
+-- functor. Could also be defined as `f >>= return . g`
+(/>) :: Functor f => f a -> (a -> b) -> f b
+(/>) = (<&>)