Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add printer combinators dual to parser combinators #71

Open
wants to merge 8 commits into
base: main
Choose a base branch
from
Open
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
63 changes: 61 additions & 2 deletions src/Data/Functor/Contravariant/Divisible.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE Safe #-}
Expand All @@ -15,9 +16,11 @@
module Data.Functor.Contravariant.Divisible
(
-- * Contravariant Applicative
Divisible(..), divided, conquered, liftD
Divisible(..), divided, conquered, liftD, (>*<), (>*), (*<)
-- * Contravariant Alternative
, Decidable(..), chosen, lost, (>*<)
, Decidable(..), chosen, lost
-- * Printer Combinators
, optionalD, manyD, many1D, sepByD, sepBy1D
-- * Mathematical definitions
-- ** Divisible
-- $divisible
Expand Down Expand Up @@ -50,6 +53,7 @@ import Data.Functor.Product
import Data.Functor.Reverse
import Data.Void

import Data.List (uncons)
import Data.Monoid (Alt(..))

import Data.Proxy
Expand Down Expand Up @@ -603,3 +607,58 @@ instance Decidable SettableStateVar where
-- In addition, we expect the same kind of distributive law as is satisfied by the usual
-- covariant 'Alternative', w.r.t 'Applicative', which should be fully formulated and
-- added here at some point!

-- | Analagous to `(*>)`
--
-- @
-- showing :: 'Show' a => 'Op' 'String' a
-- showing = 'Op' 'show'
--
-- string :: String -> 'Op' 'String' ()
-- string = 'Op' '.' 'const'
--
-- greeting :: Show a => 'Op' 'String' a
-- greeting = string "Hello " '>*' showing
-- @
(>*) :: Divisible f => f () -> f a -> f a
(>*) = divide ((),)

infixr 5 >*

-- | Analagous to `(<*)`
--
-- @
-- emphatic :: 'Op' 'String' a -> 'Op' 'String' a
-- emphatic opstring = opstring '*<' string "!"
-- @
(*<) :: Divisible f => f a -> f () -> f a
(*<) = divide (,())

infixr 5 *<
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The @gwils talk uses infixr 4. Not saying that one is correct, but is there a reason?

https://youtu.be/IJ_bVVsQhvc?t=1311

Copy link
Author

@echatav echatav Feb 28, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I haven't seen this talk yet. My reasoning was by analogy. The Applicative operators are all infixl 4.

infixl 4 <*>
infixl 4 <*
infixl 4 *>

The Divisible operator so far is infixr 5 >*< so I gave >* and *< the same fixity. I'm not sure that's "correct".

Copy link
Author

@echatav echatav Feb 28, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks like I switched the signatures of *< and >* from that talk too, oops.


mayhaps :: Maybe a -> Either () a
mayhaps m = case m of
Nothing -> Left ()
Just a -> Right a

-- | Zero or one.
optionalD :: Decidable f => f a -> f (Maybe a)
optionalD = choose mayhaps conquered

-- | Zero or more.
manyD :: Decidable f => f a -> f [a]
manyD p = choose (mayhaps . uncons) conquered (many1D p)

-- | One or more.
many1D :: Decidable f => f a -> f (a,[a])
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's possibly more ergonomic to work with a NonEmpty a than an (a, [a])?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe, but I don't really think NonEmpty is much better (and it has an evil IsList instance) than the pair and this matches better with divide. I could be convinced otherwise.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't know either; just wanted to flag it.

Copy link
Author

@echatav echatav Feb 28, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If we used NonEmpty a in many1D then you'd have to pay the cost of conjugating by the isomorphism NonEmpty a <-> (a,[a]) in manyD (at least if we do the naive thing).

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I do like NonEmpty here, even if there is a little bit of overhead.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok, I added a commit to use NonEmpty. I think the cost is n-1 calls conjugating by the isomorphism for a list of length n. Happy to make any other changes to fixity or naming.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Or I could just write a helper function and not be naive. Ok, now the cost is just 1 call conjugating by the isomorphism.

many1D p = p >*< manyD p

-- | @'sepByD' p sep@ prints zero or more occurrences of @p@, separated by @sep@.
-- Consumes a list of values required by @p@.
sepByD :: Decidable f => f () -> f a -> f [a]
sepByD sep p = choose (mayhaps . uncons) conquered (sepBy1D sep p)

-- | @'sepByD' p sep@ prints one or more occurrences of @p@, separated by @sep@.
-- Consumes a list of values required by @p@.
sepBy1D :: Decidable f => f () -> f a -> f (a,[a])
sepBy1D sep p = p >*< manyD (sep >* p)