Skip to content

Commit

Permalink
v6.0.0 (#292)
Browse files Browse the repository at this point in the history
Co-authored-by: Thomas Honeyman <admin@thomashoneyman.com>
  • Loading branch information
JordanMartinez and thomashoneyman authored Apr 27, 2022
1 parent 5f1ba9f commit 32787f4
Show file tree
Hide file tree
Showing 14 changed files with 117 additions and 56 deletions.
4 changes: 2 additions & 2 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -15,9 +15,9 @@ jobs:
with:
purescript: "unstable"

- uses: actions/setup-node@v1
- uses: actions/setup-node@v2
with:
node-version: "12"
node-version: "14.x"

- name: Install dependencies
run: |
Expand Down
10 changes: 10 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,16 @@ Notable changes to this project are documented in this file. The format is based

## [Unreleased]

Breaking changes:

New features:

Bugfixes:

Other improvements:

## [v6.0.0](https://github.com/purescript/purescript-prelude/releases/tag/v6.0.0) - 2022-04-27

Breaking changes:
- Migrated FFI to ES Modules (#287 by @kl0tl and @JordanMartinez)
- Change Generic Rep's `NoConstructors` to newtype `Void` (#282 by @JordanMartinez)
Expand Down
8 changes: 5 additions & 3 deletions src/Control/Applicative.purs
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
module Control.Applicative
( class Applicative, pure
( class Applicative
, pure
, liftA1
, unless, when
, unless
, when
, module Control.Apply
, module Data.Functor
) where
Expand Down Expand Up @@ -37,7 +39,7 @@ instance applicativeFn :: Applicative ((->) r) where
pure x _ = x

instance applicativeArray :: Applicative Array where
pure x = [x]
pure x = [ x ]

instance applicativeProxy :: Applicative Proxy where
pure _ = Proxy
Expand Down
15 changes: 11 additions & 4 deletions src/Control/Apply.purs
Original file line number Diff line number Diff line change
@@ -1,8 +1,15 @@
module Control.Apply
( class Apply, apply, (<*>)
, applyFirst, (<*)
, applySecond, (*>)
, lift2, lift3, lift4, lift5
( class Apply
, apply
, (<*>)
, applyFirst
, (<*)
, applySecond
, (*>)
, lift2
, lift3
, lift4
, lift5
, module Data.Functor
) where

Expand Down
3 changes: 2 additions & 1 deletion src/Control/Category.purs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module Control.Category
( class Category, identity
( class Category
, identity
, module Control.Semigroupoid
) where

Expand Down
2 changes: 1 addition & 1 deletion src/Control/Monad.purs
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,7 @@ whenM mb m = do
-- | Perform a monadic action unless a condition is true, where the conditional
-- | value is also in a monadic context.
unlessM :: forall m. Monad m => m Boolean -> m Unit -> m Unit
unlessM mb m = do
unlessM mb m = do
b <- mb
unless b m

Expand Down
16 changes: 9 additions & 7 deletions src/Data/EuclideanRing.purs
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
module Data.EuclideanRing
( class EuclideanRing, degree, div, mod, (/)
( class EuclideanRing
, degree
, div
, mod
, (/)
, gcd
, lcm
, module Data.CommutativeRing
Expand Down Expand Up @@ -86,13 +90,11 @@ foreign import numDiv :: Number -> Number -> Number
-- | The *greatest common divisor* of two values.
gcd :: forall a. Eq a => EuclideanRing a => a -> a -> a
gcd a b =
if b == zero
then a
else gcd b (a `mod` b)
if b == zero then a
else gcd b (a `mod` b)

-- | The *least common multiple* of two values.
lcm :: forall a. Eq a => EuclideanRing a => a -> a -> a
lcm a b =
if a == zero || b == zero
then zero
else a * b / gcd a b
if a == zero || b == zero then zero
else a * b / gcd a b
8 changes: 5 additions & 3 deletions src/Data/Function.purs
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
module Data.Function
( flip
, const
, apply, ($)
, applyFlipped, (#)
, apply
, ($)
, applyFlipped
, (#)
, applyN
, on
, module Control.Category
Expand Down Expand Up @@ -103,7 +105,7 @@ applyN :: forall a. (a -> a) -> Int -> a -> a
applyN f = go
where
go n acc
| n <= 0 = acc
| n <= 0 = acc
| otherwise = go (n - 1) (f acc)

-- | The `on` function is used to change the domain of a binary operator.
Expand Down
16 changes: 11 additions & 5 deletions src/Data/Functor.purs
Original file line number Diff line number Diff line change
@@ -1,10 +1,16 @@
module Data.Functor
( class Functor, map, (<$>)
, mapFlipped, (<#>)
( class Functor
, map
, (<$>)
, mapFlipped
, (<#>)
, void
, voidRight, (<$)
, voidLeft, ($>)
, flap, (<@>)
, voidRight
, (<$)
, voidLeft
, ($>)
, flap
, (<@>)
) where

import Data.Function (const, compose)
Expand Down
2 changes: 1 addition & 1 deletion src/Data/Ordering.purs
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ instance eqOrdering :: Eq Ordering where
eq LT LT = true
eq GT GT = true
eq EQ EQ = true
eq _ _ = false
eq _ _ = false

instance semigroupOrdering :: Semigroup Ordering where
append LT _ = LT
Expand Down
6 changes: 3 additions & 3 deletions src/Data/Semiring/Generic.purs
Original file line number Diff line number Diff line change
Expand Up @@ -5,10 +5,10 @@ import Prelude
import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), from, to)

class GenericSemiring a where
genericAdd' :: a -> a -> a
genericAdd' :: a -> a -> a
genericZero' :: a
genericMul' :: a -> a -> a
genericOne' :: a
genericMul' :: a -> a -> a
genericOne' :: a

instance genericSemiringNoArguments :: GenericSemiring NoArguments where
genericAdd' _ _ = NoArguments
Expand Down
5 changes: 3 additions & 2 deletions src/Data/Show.purs
Original file line number Diff line number Diff line change
Expand Up @@ -46,10 +46,11 @@ instance showRecord ::
( Nub rs rs
, RL.RowToList rs ls
, ShowRecordFields ls rs
) => Show (Record rs) where
) =>
Show (Record rs) where
show record = case showRecordFields (Proxy :: Proxy ls) record of
[] -> "{}"
fields -> intercalate " " ["{", intercalate ", " fields, "}"]
fields -> intercalate " " [ "{", intercalate ", " fields, "}" ]

-- | A class for records where all fields have `Show` instances, used to
-- | implement the `Show` instance for records.
Expand Down
28 changes: 16 additions & 12 deletions src/Data/Show/Generic.purs
Original file line number Diff line number Diff line change
Expand Up @@ -27,24 +27,28 @@ instance genericShowSum :: (GenericShow a, GenericShow b) => GenericShow (Sum a
genericShow' (Inl a) = genericShow' a
genericShow' (Inr b) = genericShow' b

instance genericShowArgsProduct
:: (GenericShowArgs a, GenericShowArgs b)
=> GenericShowArgs (Product a b) where
instance genericShowArgsProduct ::
( GenericShowArgs a
, GenericShowArgs b
) =>
GenericShowArgs (Product a b) where
genericShowArgs (Product a b) = genericShowArgs a <> genericShowArgs b

instance genericShowConstructor
:: (GenericShowArgs a, IsSymbol name)
=> GenericShow (Constructor name a) where
instance genericShowConstructor ::
( GenericShowArgs a
, IsSymbol name
) =>
GenericShow (Constructor name a) where
genericShow' (Constructor a) =
case genericShowArgs a of
[] -> ctor
args -> "(" <> intercalate " " ([ctor] <> args) <> ")"
case genericShowArgs a of
[] -> ctor
args -> "(" <> intercalate " " ([ ctor ] <> args) <> ")"
where
ctor :: String
ctor = reflectSymbol (Proxy :: Proxy name)
ctor :: String
ctor = reflectSymbol (Proxy :: Proxy name)

instance genericShowArgsArgument :: Show a => GenericShowArgs (Argument a) where
genericShowArgs (Argument a) = [show a]
genericShowArgs (Argument a) = [ show a ]

-- | A `Generic` implementation of the `show` member from the `Show` type class.
genericShow :: forall a rep. Generic a rep => GenericShow rep => a -> String
Expand Down
50 changes: 38 additions & 12 deletions test/Data/Generic/Rep.purs
Original file line number Diff line number Diff line change
Expand Up @@ -27,59 +27,78 @@ instance showList :: Show a => Show (List a) where
show x = GShow.genericShow x

data SimpleBounded = A | B | C | D

derive instance genericSimpleBounded :: G.Generic SimpleBounded _
instance eqSimpleBounded :: Eq SimpleBounded where
eq x y = GEq.genericEq x y

instance ordSimpleBounded :: Ord SimpleBounded where
compare x y = GOrd.genericCompare x y

instance showSimpleBounded :: Show SimpleBounded where
show x = GShow.genericShow x

instance boundedSimpleBounded :: Bounded SimpleBounded where
bottom = GBounded.genericBottom
top = GBounded.genericTop

data Option a = None | Some a

derive instance genericOption :: G.Generic (Option a) _
instance eqOption :: Eq a => Eq (Option a) where
eq x y = GEq.genericEq x y

instance ordOption :: Ord a => Ord (Option a) where
compare x y = GOrd.genericCompare x y

instance showOption :: Show a => Show (Option a) where
show x = GShow.genericShow x

instance boundedOption :: Bounded a => Bounded (Option a) where
bottom = GBounded.genericBottom
top = GBounded.genericTop

data Bit = Zero | One

derive instance genericBit :: G.Generic Bit _
instance eqBit :: Eq Bit where
eq x y = GEq.genericEq x y

instance ordBit :: Ord Bit where
compare x y = GOrd.genericCompare x y

instance showBit :: Show Bit where
show x = GShow.genericShow x

instance boundedBit :: Bounded Bit where
bottom = GBounded.genericBottom
top = GBounded.genericTop

data Pair a b = Pair a b

derive instance genericPair :: G.Generic (Pair a b) _
instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
eq = GEq.genericEq

instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
compare = GOrd.genericCompare

instance showPair :: (Show a, Show b) => Show (Pair a b) where
show = GShow.genericShow

instance boundedPair :: (Bounded a, Bounded b) => Bounded (Pair a b) where
bottom = GBounded.genericBottom
top = GBounded.genericTop

instance semiringPair :: (Semiring a, Semiring b) => Semiring (Pair a b) where
add (Pair x1 y1) (Pair x2 y2) = Pair (add x1 x2) (add y1 y2)
one = Pair one one
mul (Pair x1 y1) (Pair x2 y2) = Pair (mul x1 x2) (mul y1 y2)
zero = Pair zero zero

instance ringPair :: (Ring a, Ring b) => Ring (Pair a b) where
sub (Pair x1 y1) (Pair x2 y2) = Pair (sub x1 x2) (sub y1 y2)

instance heytingAlgebraPair :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Pair a b) where
tt = Pair tt tt
ff = Pair ff ff
Expand All @@ -88,26 +107,33 @@ instance heytingAlgebraPair :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAl
disj (Pair x1 y1) (Pair x2 y2) = Pair (disj x1 x2) (disj y1 y2)
not (Pair x y) = Pair (not x) (not y)

data A1 = A1 (Pair (Pair Int {a :: Int}) {a :: Int})
data A1 = A1 (Pair (Pair Int { a :: Int }) { a :: Int })

derive instance genericA1 :: G.Generic A1 _
instance eqA1 :: Eq A1 where
eq a = GEq.genericEq a

instance showA1 :: Show A1 where
show a = GShow.genericShow a

instance semiringA1 :: Semiring A1 where
zero = GSemiring.genericZero
one = GSemiring.genericOne
add x y = GSemiring.genericAdd x y
mul x y = GSemiring.genericMul x y

instance ringA1 :: Ring A1 where
sub x y = GRing.genericSub x y

data B1 = B1 (Pair (Pair Boolean {a :: Boolean}) {a :: Boolean})
data B1 = B1 (Pair (Pair Boolean { a :: Boolean }) { a :: Boolean })

derive instance genericB1 :: G.Generic B1 _
instance eqB1 :: Eq B1 where
eq a = GEq.genericEq a

instance showB1 :: Show B1 where
show a = GShow.genericShow a

instance heytingAlgebraB1 :: HeytingAlgebra B1 where
ff = GHeytingAlgebra.genericFF
tt = GHeytingAlgebra.genericTT
Expand Down Expand Up @@ -166,31 +192,31 @@ testGenericRep = do
top == (Pair One D :: Pair Bit SimpleBounded)

assert "Checking zero" $
(zero :: A1) == A1 (Pair (Pair 0 {a: 0}) {a: 0})
(zero :: A1) == A1 (Pair (Pair 0 { a: 0 }) { a: 0 })

assert "Checking one" $
(one :: A1) == A1 (Pair (Pair 1 {a: 1}) {a: 1})
(one :: A1) == A1 (Pair (Pair 1 { a: 1 }) { a: 1 })

assert "Checking add" $
A1 (Pair (Pair 100 {a: 10}) {a: 20}) + A1 (Pair (Pair 50 {a: 30}) {a: 40}) == A1 (Pair (Pair 150 {a: 40}) {a: 60})
A1 (Pair (Pair 100 { a: 10 }) { a: 20 }) + A1 (Pair (Pair 50 { a: 30 }) { a: 40 }) == A1 (Pair (Pair 150 { a: 40 }) { a: 60 })

assert "Checking mul" $
A1 (Pair (Pair 100 {a: 10}) {a: 20}) * A1 (Pair (Pair 50 {a: 30}) {a: 40}) == A1 (Pair (Pair 5000 {a: 300}) {a: 800})
A1 (Pair (Pair 100 { a: 10 }) { a: 20 }) * A1 (Pair (Pair 50 { a: 30 }) { a: 40 }) == A1 (Pair (Pair 5000 { a: 300 }) { a: 800 })

assert "Checking sub" $
A1 (Pair (Pair 100 {a: 10}) {a: 20}) - A1 (Pair (Pair 50 {a: 30}) {a: 40}) == A1 (Pair (Pair 50 {a: -20}) {a: -20})
A1 (Pair (Pair 100 { a: 10 }) { a: 20 }) - A1 (Pair (Pair 50 { a: 30 }) { a: 40 }) == A1 (Pair (Pair 50 { a: -20 }) { a: -20 })

assert "Checking ff" $
(ff :: B1) == B1 (Pair (Pair false {a: false}) {a: false})
(ff :: B1) == B1 (Pair (Pair false { a: false }) { a: false })

assert "Checking tt" $
(tt :: B1) == B1 (Pair (Pair true {a: true}) {a: true})
(tt :: B1) == B1 (Pair (Pair true { a: true }) { a: true })

assert "Checking conj" $
(B1 (Pair (Pair true {a: false}) {a: true}) && B1 (Pair (Pair false {a: false}) {a: true})) == B1 (Pair (Pair false { a: false }) { a: true })
(B1 (Pair (Pair true { a: false }) { a: true }) && B1 (Pair (Pair false { a: false }) { a: true })) == B1 (Pair (Pair false { a: false }) { a: true })

assert "Checking disj" $
(B1 (Pair (Pair true {a: false}) {a: true}) || B1 (Pair (Pair false {a: false}) {a: true})) == B1 (Pair (Pair true { a: false }) { a: true })
(B1 (Pair (Pair true { a: false }) { a: true }) || B1 (Pair (Pair false { a: false }) { a: true })) == B1 (Pair (Pair true { a: false }) { a: true })

assert "Checking not" $
not B1 (Pair (Pair true {a: false}) {a: true}) == B1 (Pair (Pair false {a: true}) {a: false})
not B1 (Pair (Pair true { a: false }) { a: true }) == B1 (Pair (Pair false { a: true }) { a: false })

0 comments on commit 32787f4

Please sign in to comment.