Complete Alternative

.github/workflows/ci.yml

@@ -6,7 +6,7 @@ jobs:
   build-and-test:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - name: 'Install Stack'
         uses: haskell-actions/setup@v2

README.md

@@ -31,7 +31,7 @@ After this, we recommend the following progression of modules:
 * [Parser](src/Parser.hs) *(see also [Person](src/Person.hs) for the parsing rules)*
 * [MoreParser](src/MoreParser.hs)
 * [JsonParser](src/JsonParser.hs)
-* Alternative
+* [Alternative](src/Alternative.hs)
 * Interactive
 * Anagrams
 * FastAnagrams

fp-course-haskell.cabal

@@ -19,6 +19,7 @@ extra-source-files:
 
 library
   exposed-modules:
+      Alternative
       Applicative
       Comonad
       Compose
@@ -59,6 +60,7 @@ test-suite fp-course-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      AlternativeSpec
       ApplicativeSpec
       ComonadSpec
       ComposeSpec

src/Alternative.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Alternative where
+
+import Applicative (Applicative)
+import qualified Applicative as A
+import List (List (..))
+import qualified List as L
+import Optional (Optional (..))
+import qualified Optional as O
+import Parser (ParseResult (..), Parser)
+import qualified Parser as P
+import Prelude ((.))
+
+-- | All instances of the `Alternative` type-class must satisfy three laws.
+-- These laws are not checked by the compiler. These laws are given as:
+--
+-- * The law of left identity
+--   `∀x. empty <|> x = x`
+--
+-- * The law of right identity
+--   `∀x. x <|> empty = x`
+--
+-- * The law of associativity
+--   `∀u v w. u <|> (v <|> w) = (u <|> v) <|> w`
+--
+-- You may notice that these are the same laws as Monoid. An alternative
+-- can be considered a "monoid on applicative functors". The key difference
+-- between the two classes is that Alternative is higher-kinded, meaning that
+-- the type variable @k@ itself takes a type parameter.
+-- The Alternative instance for @k@ is often distinct from any Monoid instance
+-- for @k a@.
+-- An Alternative instance should relate to the Applicative instance in some
+-- way, although the exact relation required is an open question in the community.
+-- Informally, it should be some kind of choice or alternation. Attempts to give
+-- laws relating the Applicative and Alternative are discussed here:
+-- https://wiki.haskell.org/Typeclassopedia#Laws_6
+class (Applicative k) => Alternative k where
+  zero :: k a
+
+  (<|>) :: k a -> k a -> k a
+
+infixl 3 <|>
+
+-- | Return the first full Optional.
+--
+-- >>> Full 3 <|> zero
+-- Full 3
+--
+-- >>> zero <|> Full 4
+-- Full 4
+--
+-- >>> Full 3 <|> Full 4
+-- Full 3
+instance Alternative Optional where
+  zero :: Optional a
+  zero = Empty
+
+  (<|>) :: Optional a -> Optional a -> Optional a
+  (<|>) = (O.<+>)
+
+-- | Append the lists.
+-- This instance views lists as a non-deterministic choice between elements,
+-- so the way we "alternate" them is to append the lists.
+--
+-- >>> 3 :. 4 :. 5 :. Nil <|> Nil
+-- [3,4,5]
+--
+-- >>> Nil <|> 6 :. 7 :. 8 :. Nil
+-- [6,7,8]
+--
+-- >>> 3 :. 4 :. 5 :. Nil <|> 6 :. 7 :. 8 :. Nil
+-- [3,4,5,6,7,8]
+instance Alternative List where
+  zero :: List a
+  zero = Nil
+
+  (<|>) :: List a -> List a -> List a
+  (<|>) = (L.++)
+
+-- | Choose the first succeeding parser
+--
+-- /Tip:/ Check Parser.hs
+--
+-- >>> parse (character <|> valueParser 'v') ""
+-- Result >< 'v'
+--
+-- >>> parse (constantParser UnexpectedEof <|> valueParser 'v') ""
+-- Result >< 'v'
+--
+-- >>> parse (character <|> valueParser 'v') "abc"
+-- Result >bc< 'a'
+--
+-- >>> parse (constantParser UnexpectedEof <|> valueParser 'v') "abc"
+-- Result >abc< 'v'
+instance Alternative Parser where
+  zero :: Parser a
+  zero = P.constantParser UnexpectedEof
+
+  (<|>) :: Parser a -> Parser a -> Parser a
+  (<|>) = (P.|||)
+
+-- | Run the provided Alternative action zero or more times, collecting
+-- a list of the results.
+--
+-- /Tip:/ Use @some@, @pure@ and @(<|>)@.
+--
+-- >>> parse (many character) ""
+-- Result >< ""
+--
+-- >>> parse (many digit) "123abc"
+-- Result >abc< "123"
+--
+-- >>> parse (many digit) "abc"
+-- Result >abc< ""
+--
+-- >>> parse (many character) "abc"
+-- Result >< "abc"
+--
+-- >>> parse (many (character *> valueParser 'v')) "abc"
+-- Result >< "vvv"
+--
+-- >>> parse (many (character *> valueParser 'v')) ""
+-- Result >< ""
+
+-- Recursive definition. It's impossible to implement
+-- otherwise without knowing the specialized type of k,
+-- since we need to check for the zero element.
+many :: (Alternative k) => k a -> k (List a)
+many = (<|> A.pure Nil) . some
+
+-- | Run the provided Alternative action one or more times, collecting
+-- a list of the results.
+--
+-- /Tip:/ Use @(:.)@ and @many@.
+--
+-- >>> parse (some (character)) "abc"
+-- Result >< "abc"
+--
+-- >>> parse (some (character *> valueParser 'v')) "abc"
+-- Result >< "vvv"
+--
+-- >>> isP.errorResult (parse (some (character *> valueParser 'v')) "")
+-- True
+some :: (Alternative k) => k a -> k (List a)
+some ka = A.lift2 (:.) ka (many ka)
+
+-- | Combine a list of alternatives
+--
+-- >>> aconcat (Nil :: List (List Int))
+-- []
+--
+-- >>> aconcat ((3:.4:.Nil) :. Nil :. (5:.6:.Nil) :. Nil
+-- [3,4,5,6]
+
+-- >>> aconcat (Empty :. Empty :. Full 7 :. Empty :. Full 8 :. Empty :. Nil)
+-- Full 7
+--
+-- /Note:/ In the standard library, this function is called @asum@
+aconcat :: (Alternative k) => List (k a) -> k a
+aconcat = L.foldLeft (<|>) zero

test/AlternativeSpec.hs

@@ -0,0 +1,70 @@
+module AlternativeSpec (spec) where
+
+import qualified Alternative as Alt
+import qualified Applicative as A
+import List (List (..))
+import qualified List as L
+import Optional (Optional (..))
+import Parser (ParseResult (..))
+import qualified Parser as P
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "Optional" $ do
+    it "left identity" $
+      Alt.zero Alt.<|> Full 4 `shouldBe` Full 4
+    it "right identity" $
+      Full 3 Alt.<|> Alt.zero `shouldBe` Full 3
+    it "all full" $
+      Full 3 Alt.<|> Full 4 `shouldBe` Full 3
+
+  describe "List" $ do
+    it "left identity" $
+      Alt.zero Alt.<|> 6 :. 7 :. 8 :. Nil `shouldBe` 6 :. 7 :. 8 :. Nil
+    it "right identity" $
+      3 :. 4 :. 5 :. Nil Alt.<|> Alt.zero `shouldBe` 3 :. 4 :. 5 :. Nil
+    it "all not Nil" $
+      3 :. 4 :. 5 :. Nil Alt.<|> 6 :. 7 :. 8 :. Nil
+        `shouldBe` 3 :. 4 :. 5 :. 6 :. 7 :. 8 :. Nil
+
+  describe "Parser" $ do
+    it "character or P.valueParser empty input" $
+      P.parse (P.character Alt.<|> P.valueParser 'v') (L.listh "") `shouldBe` Result Nil 'v'
+    it "zero or P.valueParser empty input" $
+      P.parse (Alt.zero Alt.<|> P.valueParser 'v') (L.listh "") `shouldBe` Result Nil 'v'
+    it "character or P.valueParser abc input" $
+      P.parse (P.character Alt.<|> P.valueParser 'v') (L.listh "abc") `shouldBe` Result (L.listh "bc") 'a'
+    it "unexpectedEof or P.valueParser abc input" $
+      P.parse (Alt.zero Alt.<|> P.valueParser 'v') (L.listh "abc")
+        `shouldBe` Result (L.listh "abc") 'v'
+
+  describe "Many" $ do
+    it "many character empty input" $
+      P.parse (Alt.many P.character) (L.listh "") `shouldBe` Result Nil Nil
+    it "many digit 123abc input" $
+      P.parse (Alt.many P.digit) (L.listh "123abc") `shouldBe` Result (L.listh "abc") (L.listh "123")
+    it "many digit abc input" $
+      P.parse (Alt.many P.digit) (L.listh "abc") `shouldBe` Result (L.listh "abc") Nil
+    it "many character abc input" $
+      P.parse (Alt.many P.character) (L.listh "abc") `shouldBe` Result Nil (L.listh "abc")
+    it "many (character to valueParser) abc input" $
+      P.parse (Alt.many (P.character A.*> P.valueParser 'v')) (L.listh "abc") `shouldBe` Result Nil (L.listh "vvv")
+    it "many (character to valueParser) empty input" $
+      P.parse (Alt.many (P.character A.*> P.valueParser 'v')) (L.listh "") `shouldBe` Result Nil Nil
+
+  describe "Some" $ do
+    it "some character abc input" $
+      P.parse (Alt.some P.character) (L.listh "abc") `shouldBe` Result Nil (L.listh "abc")
+    it "some (character to valueParser) abc input" $
+      P.parse (Alt.some (P.character A.*> P.valueParser 'v')) (L.listh "abc") `shouldBe` Result Nil (L.listh "vvv")
+    it "some (character to valueParser) empty input" $
+      P.isErrorResult (P.parse (Alt.some (P.character A.*> P.valueParser 'v')) (L.listh "")) `shouldBe` True
+
+  describe "Aconcat" $ do
+    it "empty list" $
+      Alt.aconcat (Nil :: List (List Int)) `shouldBe` Nil
+    it "several lists" $
+      Alt.aconcat ((3 :. 4 :. Nil) :. Nil :. (5 :. 6 :. Nil) :. Nil) `shouldBe` 3 :. 4 :. 5 :. 6 :. Nil
+    it "several Optionals" $
+      Alt.aconcat (Empty :. Empty :. Full 7 :. Empty :. Full 8 :. Empty :. Nil) `shouldBe` Full 7

test/JsonParserSpec.hs

@@ -2,13 +2,6 @@
 
 module JsonParserSpec (spec) where
 
--- import qualified Applicative as A
--- import qualified Data.Char as Ch
--- import qualified Functor as F
-
--- import qualified Monad as M
--- import Optional (Optional (..))
-
 import Data.Ratio ((%))
 import qualified JsonParser as JP
 import JsonValue