diff options
Diffstat (limited to 'Com')
| -rw-r--r-- | Com/InfluencedByBooks/Core.hs | 4 | ||||
| -rw-r--r-- | Com/InfluencedByBooks/Move.hs | 4 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/App.hs | 6 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Look/Typography.hs | 2 | ||||
| -rw-r--r-- | Com/Simatime/Alpha.hs | 54 |
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 +(/>) = (<&>) |