26-153605.hs

import qualified Data.Map as Map
-- record
-- data Person = Person {firstName :: String,
--                       lastName :: String,
--                       age :: Int,
--                       height :: Float,
--                       phoneNumber :: String,
--                       flavor :: String} deriving(Show)
-- guy = Person "Buddy" "Finklestein" 43 184.2 "562-2928" "Chocolate"

-- type argument
data Car = Car {company :: String, model :: String, year :: Int } deriving(Show)

tellCar :: Car -> String
tellCar (Car {company  = c, model = m, year = y}) =
  "This " ++ c ++  " " ++ m ++ " was made in " ++ show y

-- three dimensions vector
data Vector a = Vector a a a deriving(Show)

vplus :: (Num a) => Vector a -> Vector a -> Vector a
vplus (Vector x1 y1 z1) (Vector x2 y2 z2) = Vector (x1 + x2) (y1 + y2) (z1 + z2)

dotProd :: (Num a) => Vector a -> Vector a -> a
dotProd (Vector x1 y1 z1) (Vector x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2

vmult :: (Num a) => Vector a -> a -> Vector a
(Vector i j k) `vmult` m = Vector (i * m) (j * m) (k * m)

-- deriving instance
data Person = Person {firstName :: String,
                      lastName :: String,
                      age :: Int } deriving(Show, Eq, Read)

mikeD = Person {firstName = "Michael", lastName = "Diamond", age = 43}
adRock = Person {firstName = "Adam", lastName = "Horovitz", age = 41}
mca = Person {firstName = "Adam", lastName = "Yauch", age = 44}

mysteryDude = "Person {firstName = \"Michael\"" ++
              ", lastName = \"Diamond\"" ++
              ", age = 43}"

data Day = Monday | Tuseday | Wednesday | Thurseday | Friday
         | Saturday | Sunday deriving(Eq, Ord, Show, Read, Bounded, Enum)

-- Type Synonim
phoneBook :: [(String, String)]
phoneBook = [("betty", "555-2938"),
             ("bonne", "452-2928")]

type PhoneNumber = String
type Name = String
type PhoneBook = [(Name, PhoneNumber)]

type AssocList k v = [(k, v)]

-- Either
-- data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show)

data LockerState = Taken | Free deriving(Show, Eq)
type Code = String
type LockerMap = Map.Map Int (LockerState, Code)

lockerLookup :: Int -> LockerMap -> Either String Code
lockerLookup lockerNumber map =
  case Map.lookup lockerNumber map of
   Nothing -> Left $ "Locker " ++ show lockerNumber ++ " doesn't exits!"
   Just (state, code) -> if state /= Taken then Right code
                         else Left $ "Locker " ++ show lockerNumber ++ " is already taken!"

lockers :: LockerMap
lockers = Map.fromList
          [(100, (Taken, "ZD391")),
           (101, (Free, "JAH31")),
           (103, (Free, "IQSA9"))]

-- recursive data structure
infixr 5 :-:
data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord)

infixr 5 ^++
(^++) :: List a -> List a -> List a
Empty ^++ ys = ys
(x :-: xs) ^++ ys = x :-: (xs ^++ ys)

-- Tree
data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)

singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree

treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
  | x == a = Node a left right
  | x < a = Node a (treeInsert x left) right
  | x > a = Node a left $ treeInsert x right

treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem x EmptyTree = False
treeElem x (Node a left right)
  | x == a = True
  | x < a = treeElem a left
  | x > a = treeElem a right

-- type class
-- class Eq a where
--   (==) :: a -> a -> Bool
--   (/=) :: a -> a -> Bool
--   (x == y) = not (x /= y)
--   (x /= y) = not (x == y)

data TrafficLight = Red | Yellow | Green
instance Eq TrafficLight where
  Red == Red = True
  Green == Green = True
  Yellow == Yellow = True
  _ == _ = False

instance Show TrafficLight where
  show Red = "Red Light"
  show Green = "Green Light"
  show Yellow = "Yellow Light"

-- instance (Eq m) => Eq (Maybe m) where
--   Just x == Just y = x == y
--   Nothing == Nothing = True
--   _ == _ = False

--  class of Yes or No
class YesNo a where
  yesno :: a -> Bool

instance YesNo Int where
  yesno 0 = False
  yesno _ = True

instance YesNo [a] where
  yesno [] = False
  yesno _ = True

instance YesNo Bool where
  yesno = id

instance YesNo (Maybe a) where
  yesno Nothing = False
  yesno (Just _) = True

instance YesNo (Tree a) where
  yesno EmptyTree = False
  yesno _ = True

instance YesNo (TrafficLight) where
  yesno Red = False
  yesno _ = True

yesnoIf :: (YesNo y) => y -> a -> a -> a
yesnoIf yesnoVal yesResult noResult =
  if yesno yesnoVal then yesResult
  else noResult

-- Functor
-- class Functor f where
--   fmap :: (a -> b) -> f a -> f b (fは型コンストラクタ)

-- instance Functor [] where (Functorの引数は型コンストラクタ)
--   fmap = map

-- instance Functor Maybe where
--   fmap f Nothing = Nothing
--   fmap f (Just a) = Just (f a)

instance Functor Tree where
  fmap f EmptyTree = EmptyTree
  fmap f (Node a left right) = Node (f a) (fmap f left) (fmap f right)

-- instance Functor (Either a) where
--   fmap f (Right x) = Right (f x)
--   fmap f (Left x) = Left x