PureScript By Example Exercises

chapter3.purs

module Exercise where

import Prelude
import Data.AddressBook

import Data.Functor ((<$>))
import Data.List (filter, head, null, nubBy)
import Data.Maybe (Maybe)

-- 1.
findEntryByStreet :: String -> AddressBook -> Maybe Entry
findEntryByStreet street = head <<< filter filterStreet
  where
    filterStreet :: Entry -> Boolean
    filterStreet entry = entry.address.street == street

printEntryWithStreet :: String -> AddressBook -> Maybe String
printEntryWithStreet street book = map showEntry $ findEntryByStreet street book

-- 2.
checkNameInAddress :: String -> String -> AddressBook -> Boolean
checkNameInAddress firstName lastName book = null $ filter filterEntry book
  where
    filterEntry :: Entry -> Boolean
    filterEntry entry = (entry.firstName <> entry.lastName) == (firstName <> lastName)

-- 3.
sameName :: Entry -> Entry -> Boolean
sameName e1 e2 = e1.firstName == e2.firstName &&
                 e1.lastName == e2.lastName

removeDuplicates :: AddressBook -> AddressBook
removeDuplicates = nubBy sameName

chapter4.purs

module Exercise where

import Prelude

import Control.MonadZero (guard)
import Data.Array (concat, filter, foldl, null, (..), (:))
import Data.Array.Partial (head, tail)
import Partial.Unsafe (unsafePartial)

-- 1.

length :: forall a. Array a -> Int
length arr =
  if null arr
    then 0
    else 1 + length (unsafePartial tail arr)

isEven :: Int -> Boolean
isEven int =
  if int < 0
    then isEven (-int)
    else if int == 0
         then true
         else if int == 1
              then false
              else isEven (int - 2)

countEven :: Array Int -> Int
countEven arr =
  if null arr
    then 0
    else if isEven $ unsafePartial head arr
         then 1 + countEven (unsafePartial tail arr)
         else countEven (unsafePartial tail arr)

-- 2.

squareNumbers :: Array Int -> Array Int
squareNumbers = map (\num -> num * num)

removeNegatives :: Array Int -> Array Int
removeNegatives = (<$?>) (\num -> num >= 0)

infix 0 filter as <$?>

-- 3.

factors :: Int -> Array (Array Int)
factors n = do
  i <- 1 .. n
  j <- i .. n
  guard $ i * j == n
  pure [i, j]

isPrime :: Int -> Boolean
isPrime n = (length $ factors n) == 1


cartProd :: Array Int -> Array Int -> Array (Array Int)
cartProd a b = do
  i <- a
  j <- b
  pure [i, j]

pythaTriple :: Int -> Array (Array Int)
pythaTriple n = do
  i <- 1 .. n
  j <- i .. n
  k <- j .. n
  guard $ i * i + j * j == k * k
  pure [i, j, k]

factorizations :: Int -> Array Int
factorizations = concat <<< factors

-- 4.

checkAllTrue :: Array Boolean -> Boolean
checkAllTrue = foldl (\x y -> x == y) true

count :: forall a. (a -> Boolean) -> Array a -> Int
count f = count' 0
  where
    count' acc [] = acc
    count' acc xs = if f (unsafePartial head xs)
        then count' (acc + 1) (unsafePartial tail xs)
        else count' (acc) (unsafePartial tail xs)

reverse :: forall a. Array a -> Array a
reverse = foldl (\x xs -> xs : x) []

chapter5.purs

module Exercise where

import Prelude

import Data.Maybe (Maybe(..))
import Math (pow, pi)

-- 1.

factorial :: Int -> Int
factorial 0 = 1
factorial n = n * factorial (n - 1)

-- Reference from
-- https://github.com/quephird/purescript-by-example/blob/master/chapter5/src/Chapter5.purs#L13-L17
binomialCoefficient :: Int -> Int -> Int
binomialCoefficient n k | k > n = 0
binomialCoefficient n 0 = 1
binomialCoefficient n k = binomialCoefficient (n-1) (k-1) +
                          binomialCoefficient (n-1) k


-- 2.

type Address = { street :: String, city :: String }

type Person = { name :: String, address :: Address }

sameCity :: Person -> Person -> Boolean
sameCity { address: { city: x } } { address: { city: y } } = x == y

fromSingleton :: forall a. a -> Array a -> a
fromSingleton _ [x] = x
fromSingleton x _ = x

-- 3.

data Shape
  = Circle Point Number
  | Rectangle Point Number Number
  | Line Point Point
  | Text Point String

data Point = Point
  { x :: Number
  , y :: Number
  }


instance showPoint :: Show Point where
 show (Point { x, y }) =
  "(" <> show x <> ", " <> show y <> ")"

instance showShape :: Show Shape where
  show (Circle c r) =
    "Circle [center: " <> show c <> ", radius: " <> show r <> "]"
  show (Rectangle c w h) =
    "Rectangle [center: " <> show c <> ", width: " <> show w <> ", height: " <> show h <> "]"
  show (Line start end) =
    "Line [start: " <> show start <> ", end: " <> show end <> "]"
  show (Text loc text) =
    "Text [location: " <> show loc <> ", text: " <> show text <> "]"

origin :: Point
origin = Point { x, y }
  where
    x = 0.0
    y = 0.0

centerCircle :: Shape
centerCircle = Circle origin 10.0

scaleShape :: Shape -> Shape
scaleShape (Circle p r) = Circle origin (r * 2.0)
scaleShape (Rectangle p w h) = Rectangle origin (w * 2.0) (h * 2.0)
scaleShape (Line (Point start) (Point end)) = Line newStart newEnd
  where
    xdiff = start.x - end.x
    ydiff = start.y - end.y
    newStart = Point { x: -xdiff, y: -ydiff }
    newEnd = Point { x: xdiff, y: ydiff }
scaleShape (Text p text) = Text origin text

scaleShapes :: Array Shape -> Array Shape
scaleShapes = map scaleShape

findText :: Shape -> Maybe String
findText (Text _ str) = Just str
findText _ = Nothing

-- 4.

area :: Shape -> Number
area (Circle _ r) = pi * (pow r 2.0)
area (Rectangle _ w h) = w * h
area _ = 0.0

chapter6.purs

module Exercise where

import Data.Array as Array
import Data.Foldable (class Foldable, foldMap, foldl, foldr, maximum)
import Data.Maybe (Maybe(..), fromJust)
import Data.Monoid (class Monoid, mempty)
import Data.String as String
import Prelude (class Eq, class Functor, class Ord, class Semigroup, class Show, Ordering(..), map, show, (&&), (*), (-), (<<<), (<>), (==), (||))


-- 1.

newtype Complex = Complex
    { real :: Number
    , imaginary :: Number
    }

instance showComplex :: Show Complex where
  show (Complex { real, imaginary }) = show real <> " + " <> show imaginary <> "i"

instance eqComplex :: Eq Complex where
  eq (Complex c1) (Complex c2) = c1.real == c2.real && c1.imaginary == c2.imaginary

-- 2.

data NonEmpty a = NonEmpty a (Array a)

instance eqNonEmpty :: Eq a => Eq (NonEmpty a) where
  eq (NonEmpty el1 arr1) (NonEmpty el2 arr2) = (el1 == el2) && (arr1 == arr2)

instance semigroupNonEmpty :: Semigroup (NonEmpty a) where
  append (NonEmpty el1 arr1) (NonEmpty el2 arr2) = NonEmpty el1 (arr1 <> arr2)

instance functorNonEmpty :: Functor NonEmpty where
  map f (NonEmpty a arr) = NonEmpty (f a) (map f arr)

instance foldableNonEmpty :: Foldable NonEmpty where
  foldr f z (NonEmpty v arr) = foldr f z (Array.cons v arr)
  foldl f z (NonEmpty v arr) = foldl f z (Array.cons v arr)
  foldMap f (NonEmpty v arr) = foldMap f (Array.cons v arr)

data Extended a = Finite a | Infinite

instance eqExtended :: Eq a => Eq (Extended a) where
  eq a b = (a == b)

instance ordExtended :: Ord a => Ord (Extended a) where
  compare a b | (a == b) = EQ
  compare a b | (a == Infinite || b == Infinite) = GT
  compare _ _ = LT

data OneMore f a = OneMore a (f a)

instance foldableOneMore :: Foldable f => Foldable (OneMore f) where
  foldr f z (OneMore _ b) = foldr f z b
  foldl f z (OneMore _ b) = foldl f z b
  foldMap f (OneMore _ b) = foldMap f b

class Stream stream element | stream -> element where
  uncons :: stream -> Maybe { head :: element, tail :: stream }

instance streamArray :: Stream (Array a) a where
  uncons = Array.uncons

instance streamString :: Stream String Char where
  uncons = String.uncons

foldStream :: forall l e m. Stream l e => Monoid m => (e -> m) -> l -> m
foldStream f list =
  case uncons list of
    Nothing -> mempty
    Just cons -> f cons.head <> foldStream f cons.tail

-- 3.

findMax :: Partial => Array Int -> Int
findMax = fromJust <<< maximum

newtype Multiply = Multiply Int

instance semigroupMultiply :: Semigroup Multiply where
  append (Multiply n) (Multiply m) = Multiply (n * m)

instance monoidMultiply :: Monoid Multiply where
  mempty = Multiply 1

class Monoid m <= Action m a where
  act :: m -> a -> a

instance repeatAction :: Action Multiply String where
  act (Multiply n) str = act' n str where
    act' 0 acc = acc
    act' x acc = act' (x - 1) (acc <> str)

instance arrayAction :: Action m a => Action m (Array a) where
  act m a = map (\x -> act m x) a

newtype Self m = Self m

instance semigroupSelf :: Semigroup m => Semigroup (Self m) where
  append (Self n) (Self m) = Self (n <> m)

instance selfAction :: Monoid m => Action m (Self m) where
  act m a = a <> a

chapter7.purs

module Exercise where

import Prelude

import Data.AddressBook (Address(..), address)
import Data.AddressBook.Validation (Errors, matches, nonEmpty)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String.Regex (Regex, regex)
import Data.String.Regex.Flags (noFlags)
import Data.Validation.Semigroup (V)
import Partial.Unsafe (unsafePartial)

-- 1.

-- lift2 (+) (Just 1) (Just 3)
-- lift2 (+) (Just 1) Nothing

combineMaybe :: forall a f. Applicative f => Maybe (f a) -> f (Maybe a)
combineMaybe (Just a) = Just <$> a
combineMaybe Nothing = pure Nothing

-- 2.

stateRegex :: Regex
stateRegex =
  unsafePartial
    case regex "^[a-zA-Z]{2}$" noFlags of
      Right r -> r

nonEmptyRegex :: Regex
nonEmptyRegex =
  unsafePartial
    case regex "^([^\\s]?).+\\1$" noFlags of
      Right r -> r

validateAddress :: Address -> V Errors Address
validateAddress (Address o) =
  address <$> (matches "Street" nonEmptyRegex o.street *> pure o.street)
          <*> (matches "City" nonEmptyRegex o.city   *> pure o.city)
          <*> (matches "State" stateRegex o.state *> pure o.state)