trackler 1.0.4.0 → 1.0.4.1

data/tracks/haskell/exercises/leap/src/LeapYear.hs

@@ -1,4 +1,4 @@
 module LeapYear (isLeapYear) where
 
 isLeapYear :: Integer -> Bool
-isLeapYear = undefined
+isLeapYear year = undefined

data/tracks/haskell/exercises/space-age/HINTS.md

@@ -1,4 +1,16 @@
 ## Hints
 
-To complete this exercise, you need to create the data type `Planet`
-and implement the `ageOn` function.
+In this exercise, you need to complete the definition of the
+[algebric data data](http://learnyouahaskell.com/making-our-own-types-and-typeclasses)
+named `Planet`, and implement the `ageOn` function, that calculates how many
+years old someone would be on a `Planet`, given an age in seconds.
+
+Your can use the provided signature if you are unsure about the types, but
+don't let it restrict your creativity:
+
+```haskell
+ageOn :: Planet -> Float -> Float
+```
+
+Keep in mind that the test suite will not compile until you correctly
+implement the data type `Planet`.

data/tracks/haskell/exercises/space-age/examples/success-double/package.yaml

@@ -0,0 +1,19 @@
+name: space-age
+
+dependencies:
+  - base
+
+library:
+  exposed-modules: SpaceAge
+  source-dirs: src
+  dependencies:
+  # - foo       # List here the packages you
+  # - bar       # want to use in your solution.
+
+tests:
+  test:
+    main: Tests.hs
+    source-dirs: test
+    dependencies:
+      - space-age
+      - hspec

data/tracks/haskell/exercises/space-age/examples/success-rational/SpaceAge.hs

@@ -0,0 +1,24 @@
+module SpaceAge (Planet(..), ageOn) where
+
+data Planet = Mercury
+            | Venus
+            | Earth
+            | Mars
+            | Jupiter
+            | Saturn
+            | Uranus
+            | Neptune
+
+ageOn :: Real a => Planet -> a -> Rational
+ageOn planet seconds = toRational seconds / (earthPeriod * planetMultiplier)
+  where
+    planetMultiplier = case planet of
+            Mercury ->   0.2408467
+            Venus   ->   0.61519726
+            Earth   ->   1
+            Mars    ->   1.8808158
+            Jupiter ->  11.862615
+            Saturn  ->  29.447498
+            Uranus  ->  84.016846
+            Neptune -> 164.79132
+    earthPeriod = 31557600

data/tracks/haskell/exercises/space-age/examples/success-rational/package.yaml

@@ -0,0 +1,19 @@
+name: space-age
+
+dependencies:
+  - base
+
+library:
+  exposed-modules: SpaceAge
+  source-dirs: src
+  dependencies:
+  # - foo       # List here the packages you
+  # - bar       # want to use in your solution.
+
+tests:
+  test:
+    main: Tests.hs
+    source-dirs: test
+    dependencies:
+      - space-age
+      - hspec

data/tracks/haskell/exercises/space-age/src/SpaceAge.hs

@@ -1,3 +1,6 @@
 module SpaceAge (Planet(..), ageOn) where
 
-ageOn = undefined
+data Planet
+
+ageOn :: Planet -> Float -> Float
+ageOn planet seconds = undefined

data/tracks/haskell/exercises/space-age/test/Tests.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 import Data.Foldable     (for_)
+import Data.Function     (on)
 import Test.Hspec        (Spec, describe, it, shouldBe)
 import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith)
 
@@ -14,12 +15,18 @@ specs :: Spec
 specs = describe "space-age" $
           describe "ageOn" $ for_ cases test
   where
-
-    test Case{..} = it description assertion
+    -- Here we used `fromIntegral`, `fromRational` and `toRational` to
+    -- generalize the test suite, allowing any function that takes a
+    -- `Planet` and a number, returning an instance of `Real`.
+    test Case{..} = it description $ expression `shouldBeAround` expected
       where
-        expression  = ageOn planet $ fromIntegral seconds
-        assertion   = roundAge expression `shouldBe` roundAge expected
-        roundAge    = (/ 100) . fromIntegral . round . (* 100)
+        expression = fromRational
+                   . toRational
+                   . ageOn planet
+                   . fromIntegral
+                   $ seconds
+        shouldBeAround = shouldBe `on` roundTo 2
+        roundTo n = (/ 10 ^ n) . fromIntegral . round . (* 10 ^ n)
 
 -- Test cases adapted from `exercism/x-common/space-age.json` on 2016-07-27.
 

data/tracks/haskell/exercises/word-count/HINTS.md

@@ -0,0 +1,21 @@
+## Hints
+
+To complete this exercise you need to implement the function `wordCount`,
+that takes a *text* and returns how many times each *word* appears.
+
+If it is your first time solving this exercise, it is recommended that you
+stick to the provided signature:
+
+```haskell
+wordCount :: String -> [(String, Int)]
+```
+
+Later, it may be a good idea to revisit this problem and play with other data
+types and libraries:
+
+- `Text`, from package *text*.
+- `Map`, from package *containers*.
+- `MultiSet`, from package *multiset*
+
+The test suite was intentionally designed to accept almost any type signature
+that makes sense, so you are encouraged to find the one you think is the best.

data/tracks/haskell/exercises/word-count/examples/success-newtype/WordCount.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module WordCount (wordCount) where
+
+import Prelude hiding (null)
+import Data.Char      (isAlphaNum)
+import Data.Text      (Text, null, split, toLower)
+import Data.MultiSet  (MultiSet, Occur, fromList, fromOccurList, toOccurList)
+
+import qualified GHC.Exts (IsList(..))
+
+wordCount :: Text -> Bag Text
+wordCount = Bag
+          . fromList
+          . map toLower
+          . wordsBy (not . isAlphaNum)
+
+-- The `text` package misses this function that
+-- exists in package `split`, but works on lists.
+wordsBy :: (Char -> Bool) -> Text -> [Text]
+wordsBy p = filter (not . null) . split p
+
+-- MultiSet is not an instance of `IsList`, so we create
+-- a newtype to wrap it, avoiding an orphan instance.
+newtype Bag a = Bag { toMultiSet :: MultiSet a }
+
+instance (Ord a) => GHC.Exts.IsList (Bag a)
+  where
+    type Item (Bag a) = (a, Occur)
+    fromList = Bag . fromOccurList
+    toList   = toOccurList . toMultiSet

data/tracks/haskell/exercises/word-count/examples/success-newtype/package.yaml

@@ -0,0 +1,21 @@
+name: word-count
+
+dependencies:
+  - base
+
+library:
+  exposed-modules: WordCount
+  source-dirs: src
+  dependencies:
+  # - foo       # List here the packages you
+  # - bar       # want to use in your solution.
+    - multiset
+    - text
+
+tests:
+  test:
+    main: Tests.hs
+    source-dirs: test
+    dependencies:
+      - word-count
+      - hspec

data/tracks/haskell/exercises/word-count/examples/success-simple/WordCount.hs

@@ -0,0 +1,13 @@
+module WordCount (wordCount) where
+
+import Control.Arrow   ((&&&))
+import Data.Char       (toLower, isAlphaNum)
+import Data.List       (group, sort)
+import Data.List.Split (wordsBy)
+
+wordCount :: String -> [(String, Int)]
+wordCount = map (head &&& length)
+          . group
+          . sort
+          . map (map toLower)
+          . wordsBy (not . isAlphaNum)

data/tracks/haskell/exercises/word-count/examples/success-simple/package.yaml

@@ -0,0 +1,20 @@
+name: word-count
+
+dependencies:
+  - base
+
+library:
+  exposed-modules: WordCount
+  source-dirs: src
+  dependencies:
+  # - foo       # List here the packages you
+  # - bar       # want to use in your solution.
+    - split
+
+tests:
+  test:
+    main: Tests.hs
+    source-dirs: test
+    dependencies:
+      - word-count
+      - hspec

data/tracks/haskell/exercises/word-count/package.yaml

@@ -2,7 +2,6 @@ name: word-count
 
 dependencies:
   - base
-  - containers
 
 library:
   exposed-modules: WordCount
@@ -10,7 +9,6 @@ library:
   dependencies:
   # - foo       # List here the packages you
   # - bar       # want to use in your solution.
-    - split
 
 tests:
   test:

data/tracks/haskell/exercises/word-count/src/WordCount.hs

@@ -1,3 +1,4 @@
 module WordCount (wordCount) where
 
-wordCount = undefined
+wordCount :: String -> [(String, Int)]
+wordCount xs = undefined

data/tracks/haskell/exercises/word-count/test/Tests.hs

@@ -1,9 +1,11 @@
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-# LANGUAGE RecordWildCards #-}
 
+import Data.Bifunctor    (bimap)
+import Data.Char         (toLower)
 import Data.Foldable     (for_)
-import Data.Map          (fromList)
-import Test.Hspec        (Spec, describe, it, shouldBe)
+import GHC.Exts          (fromList, toList)
+import Test.Hspec        (Spec, describe, it, shouldMatchList)
 import Test.Hspec.Runner (configFastFail, defaultConfig, hspecWith)
 
 import WordCount (wordCount)
@@ -15,11 +17,18 @@ specs :: Spec
 specs = describe "word-count" $
           describe "wordCount" $ for_ cases test
   where
-
-    test Case{..} = it description $ returnedMap `shouldBe` expectedMap
+    -- Here we used `fromIntegral`, `fromList` and `toList` to generalize
+    -- the tests, accepting any function that receives a string-like argumment
+    -- and returns a type that can be converted to [(String, Integer)].
+    -- Also, the words are lower-cased before comparison and the output's
+    -- order is ignored.
+    test Case{..} = it description $ expression `shouldMatchList` expected
       where
-        returnedMap = wordCount input
-        expectedMap = fromIntegral <$> fromList expected
+        expression = map (bimap (map toLower . toList) fromIntegral)
+                   . toList
+                   . wordCount
+                   . fromList
+                   $ input
 
 -- Test cases adapted from `exercism/x-common/word-count.json` on 2016-07-26.
 

data/tracks/haskell/exercises/zebra-puzzle/package.yaml

@@ -0,0 +1,19 @@
+name: zebra-puzzle
+
+dependencies:
+  - base
+
+library:
+  exposed-modules: ZebraPuzzle
+  source-dirs: src
+  dependencies:
+  # - foo       # List here the packages you
+  # - bar       # want to use in your solution.
+
+tests:
+  test:
+    main: Tests.hs
+    source-dirs: test
+    dependencies:
+      - zebra-puzzle
+      - hspec

data/tracks/haskell/exercises/zebra-puzzle/src/Example.hs

@@ -0,0 +1,113 @@
+module ZebraPuzzle (Resident(..), Solution(..), solve) where
+
+import Control.Monad (guard)
+import Data.List (nub, find)
+import Data.Maybe (fromJust)
+
+data Color = Red | Green | Yellow | Blue | Ivory
+  deriving (Eq, Show, Enum)
+data Resident = Englishman | Spaniard | Ukrainian | Norwegian | Japanese
+  deriving (Eq, Show, Enum)
+data Pet = Dog | Snails | Fox | Horse | Zebra
+  deriving (Eq, Show, Enum)
+data Beverage = Coffee | Tea | Milk | OrangeJuice | Water
+  deriving (Eq, Show, Enum)
+data Cigarette = OldGold | Kools | Chesterfields | LuckyStrike | Parliaments
+  deriving (Eq, Show, Enum)
+data Position = One | Two | Three | Four | Five
+  deriving (Eq, Show, Enum)
+
+data House = House { position :: Position
+                   , color :: Color
+                   , resident :: Resident
+                   , beverage :: Beverage
+                   , cigarette :: Cigarette
+                   , pet :: Pet
+                   } deriving (Show)
+
+data Solution = Solution { waterDrinker :: Resident
+                         , zebraOwner :: Resident
+                         } deriving (Eq, Show)
+
+solve :: Solution
+solve = Solution waterDrinker' zebraOwner'
+  where
+    waterDrinker' = residentWith beverage Water
+    zebraOwner'   = residentWith pet Zebra
+    residentWith :: (Eq a) => (House -> a) -> a -> Resident
+    residentWith what value = resident $ houseWith what value fiveHouses
+
+fiveHouses :: [House]
+fiveHouses = head $ do
+  one   <- housesAtPosition One
+  two   <- housesAtPosition Two
+  guard $ uniqueHouses [one, two]   -- prune search tree as early as possible
+  three <- housesAtPosition Three
+  guard $ uniqueHouses [one, two, three]
+  four  <- housesAtPosition Four
+  guard $ uniqueHouses [one, two, three, four]
+  five  <- housesAtPosition Five
+  let candidates = [one, two, three, four, five]
+  guard $ uniqueHouses candidates
+  guard $ validPositions candidates
+  return candidates
+  where
+    housesAtPosition :: Position -> [House]
+    housesAtPosition pos = filter ((== pos) . position) validHouses
+
+validHouses :: [House]
+validHouses = do
+  position' <- [One .. Five]
+  color' <- [Red .. Ivory]
+  resident' <- [Englishman .. Japanese]
+  beverage' <- [Coffee .. Water]
+  cigarette' <- [OldGold .. Parliaments]
+  pet' <- [Dog .. Zebra]
+  let house = House position' color' resident' beverage' cigarette' pet'
+  guard $ validHouse house
+  return house
+
+validHouse :: House -> Bool
+validHouse (House position' color' resident' beverage' cigarette' pet') =
+  all (uncurry iff) [
+    (color' == Red, resident' == Englishman),
+    (resident' == Spaniard, pet' == Dog),
+    (color' == Green, beverage' == Coffee),
+    (resident' == Ukrainian, beverage' == Tea),
+    (cigarette' == OldGold, pet' == Snails),
+    (color' == Yellow, cigarette' == Kools),
+    (position' == Three, beverage' == Milk),
+    (position' == One, resident' == Norwegian),
+    (beverage' == OrangeJuice, cigarette' == LuckyStrike),
+    (resident' == Japanese, cigarette' == Parliaments)
+  ]
+
+iff :: Bool -> Bool -> Bool
+iff True  True  = True
+iff False False = True
+iff _     _     = False
+
+uniqueHouses :: [House] -> Bool
+uniqueHouses houses =
+  unique color && unique resident && unique beverage &&
+  unique cigarette && unique pet
+  where
+    unique :: (Eq a) => (House -> a) -> Bool
+    unique what = (== length houses) . length . nub $ map what houses
+
+houseWith :: (Eq a) => (House -> a) -> a -> [House] -> House
+houseWith what value = fromJust . find ((== value) . what)
+
+validPositions :: [House] -> Bool
+validPositions houses =
+  houseWith' color Green `toTheRight` houseWith' color Ivory &&
+  houseWith' cigarette Chesterfields `nextTo` houseWith' pet Fox &&
+  houseWith' cigarette Kools `nextTo` houseWith' pet Horse &&
+  houseWith' resident Norwegian `nextTo` houseWith' color Blue
+  where
+    houseWith' what value = houseWith what value houses
+    toTheRight :: House -> House -> Bool
+    toTheRight h1 h2 = fromEnum (position h1) == fromEnum (position h2) + 1
+    nextTo :: House -> House -> Bool
+    nextTo h1 h2 = abs (fromEnum (position h1) - fromEnum (position h2)) == 1
+

data/tracks/haskell/exercises/zebra-puzzle/src/ZebraPuzzle.hs

@@ -0,0 +1,12 @@
+module ZebraPuzzle (Resident(..), Solution(..), solve) where
+
+data Resident = Englishman | Spaniard | Ukrainian | Norwegian | Japanese
+  deriving (Eq, Show)
+
+data Solution = Solution { waterDrinker :: Resident
+                         , zebraOwner :: Resident
+                         } deriving (Eq, Show)
+
+solve :: Solution
+solve = undefined
+