diff --git a/src/Functor.hs b/src/Functor.hs index 1eed2ab..6f2383f 100644 --- a/src/Functor.hs +++ b/src/Functor.hs @@ -5,9 +5,13 @@ module Functor where import Core -import ExactlyOne -import List -import Optional +import Data.Function ((&)) +import ExactlyOne (ExactlyOne (..)) +import qualified ExactlyOne as EO +import List (List (..)) +import qualified List as L +import Optional (Optional (..)) +import qualified Optional as O import qualified Prelude as P (fmap) -- | All instances of the `Functor` type-class must satisfy two laws. These laws @@ -35,7 +39,7 @@ infixl 4 <$> -- ExactlyOne 3 instance Functor ExactlyOne where (<$>) :: (a -> b) -> ExactlyOne a -> ExactlyOne b - (<$>) = mapExactlyOne + (<$>) = EO.mapExactlyOne -- | Maps a function on the List functor. -- @@ -46,7 +50,7 @@ instance Functor ExactlyOne where -- [2,3,4] instance Functor List where (<$>) :: (a -> b) -> List a -> List b - (<$>) = map + (<$>) = L.map -- | Maps a function on the Optional functor. -- @@ -57,7 +61,7 @@ instance Functor List where -- Full 3 instance Functor Optional where (<$>) :: (a -> b) -> Optional a -> Optional b - (<$>) = mapOptional + (<$>) = O.mapOptional -- | Maps a function on the reader ((->) t) functor. -- @@ -98,8 +102,8 @@ instance Functor ((->) t) where -- >>> Empty ?? 2 -- Empty (??) :: (Functor k) => k (a -> b) -> a -> k b --- ($) :: (a -> b) -> a -> b -(??) ff a = flip ($) a <$> ff +-- (&) :: a -> (a -> b) -> b +(??) = flip ((<$>) . (&)) infixl 1 ?? @@ -117,7 +121,7 @@ infixl 1 ?? -- >>> void (+10) 5 -- () void :: (Functor k) => k a -> k () -void = (<$>) (const ()) +void = (<$) () ----------------------- -- SUPPORT LIBRARIES -- diff --git a/src/List.hs b/src/List.hs index 2b60bf1..82f4ef2 100644 --- a/src/List.hs +++ b/src/List.hs @@ -19,7 +19,8 @@ import qualified Control.Applicative as A import qualified Control.Monad as M import Core import qualified Numeric as N -import Optional +import Optional (Optional (..)) +import qualified Optional as O import qualified System.Environment as E import qualified Prelude as P @@ -207,7 +208,8 @@ flattenAgain = flatten -- Empty seqOptional :: List (Optional a) -> Optional (List a) seqOptional Nil = Full Nil -seqOptional (x :. xs) = (:.) P.<$> x P.<*> seqOptional xs +-- (:.) P.<$> x P.<*> seqOptional xs +seqOptional (x :. xs) = O.twiceOptional (:.) x (seqOptional xs) -- | Find the first element in the list matching the predicate. -- @@ -577,7 +579,7 @@ read :: Chars -> Optional a read = - mapOptional fst . reads + O.mapOptional fst . reads readHexs :: (Eq a, Num a) => @@ -593,7 +595,7 @@ readHex :: Chars -> Optional a readHex = - mapOptional fst . readHexs + O.mapOptional fst . readHexs readFloats :: (RealFrac a) => @@ -609,7 +611,7 @@ readFloat :: Chars -> Optional a readFloat = - mapOptional fst . readFloats + O.mapOptional fst . readFloats instance (a P.~ Char) => IsString (List a) where -- Per https://hackage.haskell.org/package/base-4.14.1.0/docs/src/Data.String.html#line-43 diff --git a/test/FunctorSpec.hs b/test/FunctorSpec.hs index 00b5e40..bcc351b 100644 --- a/test/FunctorSpec.hs +++ b/test/FunctorSpec.hs @@ -1,6 +1,6 @@ module FunctorSpec (spec) where -import ExactlyOne +import ExactlyOne (ExactlyOne (..)) import qualified Functor as F import List (List (..)) import Optional (Optional (..)) diff --git a/test/ListSpec.hs b/test/ListSpec.hs index a5761f3..cca6393 100644 --- a/test/ListSpec.hs +++ b/test/ListSpec.hs @@ -3,7 +3,7 @@ module ListSpec (spec) where import List (List (..)) -import qualified List +import qualified List as L import Optional (Optional (..)) import Property () import Test.Hspec @@ -13,145 +13,145 @@ spec :: Spec spec = do describe "headOr" $ do it "headOr on non-empty list" $ - List.headOr 3 (1 :. 2 :. Nil) `shouldBe` (1 :: Int) + L.headOr 3 (1 :. 2 :. Nil) `shouldBe` (1 :: Int) it "headOr on empty list" $ - List.headOr 3 Nil `shouldBe` (3 :: Int) + L.headOr 3 Nil `shouldBe` (3 :: Int) prop "headOr on infinity always 0" $ - \x -> x `List.headOr` List.infinity `shouldBe` 0 + \x -> x `L.headOr` L.infinity `shouldBe` 0 prop "headOr on empty list always the default" $ - \x -> (x :: Integer) `List.headOr` Nil `shouldBe` x + \x -> (x :: Integer) `L.headOr` Nil `shouldBe` x describe "product" $ do it "product of empty list" $ - List.product Nil `shouldBe` 1 + L.product Nil `shouldBe` 1 it "product of 1..3" $ - List.product (1 :. 2 :. 3 :. Nil) `shouldBe` 6 + L.product (1 :. 2 :. 3 :. Nil) `shouldBe` 6 it "product of 1..4" $ - List.product (1 :. 2 :. 3 :. 4 :. Nil) `shouldBe` 24 + L.product (1 :. 2 :. 3 :. 4 :. Nil) `shouldBe` 24 describe "sum" $ do it "sum of empty list" $ - List.sum Nil `shouldBe` 0 + L.sum Nil `shouldBe` 0 it "sum of 1..3" $ - List.sum (1 :. 2 :. 3 :. Nil) `shouldBe` 6 + L.sum (1 :. 2 :. 3 :. Nil) `shouldBe` 6 it "sum of 1..4" $ - List.sum (1 :. 2 :. 3 :. 4 :. Nil) `shouldBe` 10 + L.sum (1 :. 2 :. 3 :. 4 :. Nil) `shouldBe` 10 prop "subtracting each element in a list from its sum is always 0" $ - \xs -> List.foldLeft (-) (List.sum xs) xs `shouldBe` 0 + \xs -> L.foldLeft (-) (L.sum xs) xs `shouldBe` 0 describe "length" $ do it "length of empty list" $ - List.length Nil `shouldBe` 0 + L.length Nil `shouldBe` 0 it "length 1..3" $ - List.length ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` 3 + L.length ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` 3 prop "summing a list of 1s is equal to its length" $ - \xs -> length (List.hlist xs) `shouldBe` List.length (xs :: List Integer) + \xs -> length (L.hlist xs) `shouldBe` L.length (xs :: List Integer) describe "map" $ do it "add 10 on list" $ - List.map (+ 10) ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` (11 :. 12 :. 13 :. Nil) + L.map (+ 10) ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` (11 :. 12 :. 13 :. Nil) prop "headOr after map" $ - \x -> List.headOr (x :: Integer) (List.map (+ 1) List.infinity) `shouldBe` 1 + \x -> L.headOr (x :: Integer) (L.map (+ 1) L.infinity) `shouldBe` 1 {- HLINT ignore "Redundant map" -} prop "map id is id" $ - \xs -> List.map id xs `shouldBe` (xs :: List Integer) + \xs -> L.map id xs `shouldBe` (xs :: List Integer) describe "filter" $ do it "filter even" $ - List.filter even ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` (2 :. 4 :. Nil) + L.filter even ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` (2 :. 4 :. Nil) prop "filter (const True) is identity (headOr)" $ - \x -> List.headOr x (List.filter (const True) List.infinity) `shouldBe` 0 + \x -> L.headOr x (L.filter (const True) L.infinity) `shouldBe` 0 prop "filter (const True) is identity" $ - \xs -> List.filter (const True) xs `shouldBe` (xs :: List Integer) + \xs -> L.filter (const True) xs `shouldBe` (xs :: List Integer) prop "filter (const False) is the empty list" $ - \xs -> List.filter (const False) xs `shouldBe` (Nil :: List Integer) + \xs -> L.filter (const False) xs `shouldBe` (Nil :: List Integer) describe "++" $ do it "(1..6)" $ - ((1 :: Int) :. 2 :. 3 :. Nil) List.++ (4 :. 5 :. 6 :. Nil) `shouldBe` List.listh [1, 2, 3, 4, 5, 6] + ((1 :: Int) :. 2 :. 3 :. Nil) L.++ (4 :. 5 :. 6 :. Nil) `shouldBe` L.listh [1, 2, 3, 4, 5, 6] prop "append empty to infinite" $ - \x -> List.headOr x (Nil List.++ List.infinity) `shouldBe` 0 + \x -> L.headOr x (Nil L.++ L.infinity) `shouldBe` 0 prop "append anything to infinite" $ - \(x, ys) -> List.headOr x (ys List.++ List.infinity) `shouldBe` List.headOr 0 ys + \(x, ys) -> L.headOr x (ys L.++ L.infinity) `shouldBe` L.headOr 0 ys prop "associativity" $ - \xs ys zs -> (xs List.++ ys) List.++ zs `shouldBe` (xs List.++ (ys List.++ zs) :: List Integer) + \xs ys zs -> (xs L.++ ys) L.++ zs `shouldBe` (xs L.++ (ys L.++ zs) :: List Integer) prop "append to empty list" $ - \x -> x List.++ Nil `shouldBe` (x :: List Integer) + \x -> x L.++ Nil `shouldBe` (x :: List Integer) describe "flatten" $ do it "(1..9)" $ - List.flatten (((1 :: Int) :. 2 :. 3 :. Nil) :. (4 :. 5 :. 6 :. Nil) :. (7 :. 8 :. 9 :. Nil) :. Nil) `shouldBe` List.listh [1, 2, 3, 4, 5, 6, 7, 8, 9] + L.flatten (((1 :: Int) :. 2 :. 3 :. Nil) :. (4 :. 5 :. 6 :. Nil) :. (7 :. 8 :. 9 :. Nil) :. Nil) `shouldBe` L.listh [1, 2, 3, 4, 5, 6, 7, 8, 9] prop "flatten (infinity :. y)" $ - \(x, ys) -> List.headOr x (List.flatten (List.infinity :. ys :. Nil)) `shouldBe` 0 + \(x, ys) -> L.headOr x (L.flatten (L.infinity :. ys :. Nil)) `shouldBe` 0 prop "flatten (y :. infinity)" $ - \(x, ys) -> List.headOr x (List.flatten (ys :. List.infinity :. Nil)) `shouldBe` List.headOr 0 ys + \(x, ys) -> L.headOr x (L.flatten (ys :. L.infinity :. Nil)) `shouldBe` L.headOr 0 ys prop "sum of lengths == length of flattened" $ - \xs -> List.sum (List.map List.length xs) `shouldBe` List.length (List.flatten (xs :: List (List Integer))) + \xs -> L.sum (L.map L.length xs) `shouldBe` L.length (L.flatten (xs :: List (List Integer))) describe "flatMap" $ do it "lists of Integer" $ - List.flatMap (\x -> x :. x + 1 :. x + 2 :. Nil) ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` List.listh [1, 2, 3, 2, 3, 4, 3, 4, 5] + L.flatMap (\x -> x :. x + 1 :. x + 2 :. Nil) ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` L.listh [1, 2, 3, 2, 3, 4, 3, 4, 5] prop "flatMap id flattens a list of lists" $ - \(x, ys) -> List.headOr x (List.flatMap id (List.infinity :. ys :. Nil)) `shouldBe` 0 + \(x, ys) -> L.headOr x (L.flatMap id (L.infinity :. ys :. Nil)) `shouldBe` 0 prop "flatMap id on a list of lists take 2" $ - \(x, ys) -> List.headOr x (List.flatMap id (ys :. List.infinity :. Nil)) `shouldBe` List.headOr 0 ys + \(x, ys) -> L.headOr x (L.flatMap id (ys :. L.infinity :. Nil)) `shouldBe` L.headOr 0 ys prop "flatMap id == flatten" $ - \xs -> List.flatMap id xs `shouldBe` List.flatten (xs :: List (List Integer)) + \xs -> L.flatMap id xs `shouldBe` L.flatten (xs :: List (List Integer)) describe "flattenAgain" $ do prop "lists of Integer" $ - \xs -> List.flatten xs `shouldBe` List.flattenAgain (xs :: List (List Integer)) + \xs -> L.flatten xs `shouldBe` L.flattenAgain (xs :: List (List Integer)) describe "seqOptional" $ do it "all Full" $ - List.seqOptional (Full (1 :: Int) :. Full 10 :. Nil) `shouldBe` Full (1 :. 10 :. Nil) + L.seqOptional (Full (1 :: Int) :. Full 10 :. Nil) `shouldBe` Full (1 :. 10 :. Nil) it "empty list" $ let empty = Nil :: List (Optional Integer) - in List.seqOptional empty `shouldBe` Full Nil + in L.seqOptional empty `shouldBe` Full Nil it "contains Empty" $ - List.seqOptional (Full (1 :: Int) :. Full 10 :. Empty :. Nil) `shouldBe` Empty + L.seqOptional (Full (1 :: Int) :. Full 10 :. Empty :. Nil) `shouldBe` Empty it "Empty at head of infinity" $ - List.seqOptional (Empty :. List.map Full List.infinity) `shouldBe` Empty + L.seqOptional (Empty :. L.map Full L.infinity) `shouldBe` Empty describe "find" $ do it "find no matches" $ - List.find even ((1 :: Int) :. 3 :. 5 :. Nil) `shouldBe` Empty + L.find even ((1 :: Int) :. 3 :. 5 :. Nil) `shouldBe` Empty it "empty list" $ - List.find even (Nil :: List Integer) `shouldBe` Empty + L.find even (Nil :: List Integer) `shouldBe` Empty it "find only even" $ - List.find even ((1 :: Int) :. 2 :. 3 :. 5 :. Nil) `shouldBe` Full 2 + L.find even ((1 :: Int) :. 2 :. 3 :. 5 :. Nil) `shouldBe` Full 2 it "find first, not second even" $ - List.find even ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` Full 2 + L.find even ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` Full 2 it "find on infinite list" $ - List.find (const True) List.infinity `shouldBe` Full 0 + L.find (const True) L.infinity `shouldBe` Full 0 describe "lengthGT4" $ do it "list of length 3" $ - List.lengthGT4 ((1 :: Int) :. 3 :. 5 :. Nil) `shouldBe` False + L.lengthGT4 ((1 :: Int) :. 3 :. 5 :. Nil) `shouldBe` False it "list of length 4" $ - List.lengthGT4 ((1 :: Int) :. 2 :. 3 :. 4 :. Nil) `shouldBe` False + L.lengthGT4 ((1 :: Int) :. 2 :. 3 :. 4 :. Nil) `shouldBe` False it "empty list" $ - List.lengthGT4 Nil `shouldBe` False + L.lengthGT4 Nil `shouldBe` False it "list of length 5" $ - List.lengthGT4 ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` True + L.lengthGT4 ((1 :: Int) :. 2 :. 3 :. 4 :. 5 :. Nil) `shouldBe` True it "infinite list" $ - List.lengthGT4 List.infinity `shouldBe` True + L.lengthGT4 L.infinity `shouldBe` True describe "reverse" $ do it "empty list" $ - List.reverse Nil `shouldBe` (Nil :: List Integer) + L.reverse Nil `shouldBe` (Nil :: List Integer) {- HLINT ignore "Avoid reverse" -} it "reverse . reverse on largeList" $ - List.take (1 :: Int) (List.reverse (List.reverse List.largeList)) `shouldBe` (1 :. Nil) + L.take (1 :: Int) (L.reverse (L.reverse L.largeList)) `shouldBe` (1 :. Nil) prop "reverse then append is same as append then reverse" $ - \xs ys -> List.reverse xs List.++ List.reverse ys `shouldBe` (List.reverse (ys List.++ xs) :: List Integer) + \xs ys -> L.reverse xs L.++ L.reverse ys `shouldBe` (L.reverse (ys L.++ xs) :: List Integer) prop "reverse single element list is the list" $ - \x -> List.reverse (x :. Nil) `shouldBe` (x :. Nil :: List Integer) + \x -> L.reverse (x :. Nil) `shouldBe` (x :. Nil :: List Integer) describe "produce" $ do it "increment" $ - let (x :. y :. z :. w :. _) = List.produce (+ 1) 0 + let (x :. y :. z :. w :. _) = L.produce (+ 1) 0 in (x :. y :. z :. w :. Nil) `shouldBe` ((0 :: Int) :. 1 :. 2 :. 3 :. Nil) it "double" $ - let (x :. y :. z :. w :. _) = List.produce (* 2) 1 + let (x :. y :. z :. w :. _) = L.produce (* 2) 1 in (x :. y :. z :. w :. Nil) `shouldBe` ((1 :: Int) :. 2 :. 4 :. 8 :. Nil) diff --git a/test/OptionalSpec.hs b/test/OptionalSpec.hs index 018a332..500626b 100644 --- a/test/OptionalSpec.hs +++ b/test/OptionalSpec.hs @@ -1,45 +1,45 @@ module OptionalSpec (spec) where -import Optional (Optional (..)) -import qualified Optional as Opt +import Optional (Optional (..), (<+>)) +import qualified Optional as O import Test.Hspec spec :: Spec spec = do describe "mapOptional" $ do it "Empty" $ - Opt.mapOptional (+ 1) Empty `shouldBe` (Empty :: Optional Int) + O.mapOptional (+ 1) Empty `shouldBe` (Empty :: Optional Int) it "Full" $ - Opt.mapOptional (+ 1) (Full 8) `shouldBe` Full (9 :: Int) + O.mapOptional (+ 1) (Full 8) `shouldBe` Full (9 :: Int) describe "bindOptional" $ do let evenDecOddInc n = if even n then Full (n - 1) else Full (n + 1) it "Empty" $ - Opt.bindOptional Full Empty `shouldBe` (Empty :: Optional Integer) + O.bindOptional Full Empty `shouldBe` (Empty :: Optional Integer) it "even dec, odd inc, even input" $ - Opt.bindOptional evenDecOddInc (Full 8) `shouldBe` (Full 7 :: Optional Int) + O.bindOptional evenDecOddInc (Full 8) `shouldBe` (Full 7 :: Optional Int) it "even dec, odd inc, odd input" $ - Opt.bindOptional evenDecOddInc (Full 9) `shouldBe` (Full 10 :: Optional Int) + O.bindOptional evenDecOddInc (Full 9) `shouldBe` (Full 10 :: Optional Int) describe "fullOr" $ do it "Full" $ - Opt.fullOr 99 (Full 8) `shouldBe` (8 :: Int) + O.fullOr 99 (Full 8) `shouldBe` (8 :: Int) it "Empty" $ - Opt.fullOr 99 Empty `shouldBe` (99 :: Int) + O.fullOr 99 Empty `shouldBe` (99 :: Int) describe "<+>" $ do it "first Full" $ - Full 8 Opt.<+> Empty `shouldBe` Full (8 :: Int) + Full 8 <+> Empty `shouldBe` Full (8 :: Int) it "both Full" $ - Full 8 Opt.<+> Full 9 `shouldBe` Full (8 :: Int) + Full 8 <+> Full 9 `shouldBe` Full (8 :: Int) it "first Empty" $ - Empty Opt.<+> Full 9 `shouldBe` Full (9 :: Int) + Empty <+> Full 9 `shouldBe` Full (9 :: Int) it "both empty" $ - Empty Opt.<+> Empty `shouldBe` (Empty :: Optional Integer) + Empty <+> Empty `shouldBe` (Empty :: Optional Integer) describe "optional" $ do it "replaces full data constructor" $ - Opt.optional (+ 1) 0 (Full 8) `shouldBe` (9 :: Int) + O.optional (+ 1) 0 (Full 8) `shouldBe` (9 :: Int) it "replaces empty data constructor" $ - Opt.optional (+ 1) 0 Empty `shouldBe` (0 :: Int) + O.optional (+ 1) 0 Empty `shouldBe` (0 :: Int)