{-
File: datatypes.hs
Author: Max Levatich
-}

-- This is how you turn on language extensions. Put these at the top of the file.
-- RecordWildCards lets us use the '..' expression to fill in named fields
-- in the maxwell :: Person example on line 151
{-# LANGUAGE RecordWildCards #-}

-- Our very first custom datatype: Cooleans!
-- It has two constructors: CoolTrue and CoolFalse
data Cool = CoolTrue
          | CoolFalse
          deriving (Show)

-- A function that operates on Cooleans with pattern matching
-- Note that the datatype is used in the type signature, while the
-- constructors are used in the function body
coolAnd :: Cool -> Cool -> Cool
coolAnd CoolTrue CoolTrue = CoolTrue
coolAnd _        _        = CoolFalse

-- Type aliases: When we write 'URL' or 'HTML', we just mean 'String'!
-- Helps you, the programmer keep things straight
type URL = String
type HTML = String

-- An example of a datatype where the constructors have fields.
-- A successful server response includes html, and an error includes a status code.
data ServerResponse = Success HTML
                    | Error Int
                    deriving (Eq, Show)

-- Example of pattern matching on constructors with fields.
handleResponse :: ServerResponse -> String
handleResponse (Success html)     =
    "success! the html we got back was  a " ++ html
handleResponse (Error statuscode) =
    "failure! the status code we got back was " ++ show statuscode

-- We didn't make a proper implementation for this one
sendRequest :: URL -> ServerResponse
sendRequest _ = Error 404

-- Our own version of the list datatype. This is exactly
-- how lists are implemented in Haskell, just with [] and (:) as syntactic sugar.
-- Note 1: This datatype has a polymorphic type argument:
-- CoolList isn't a type, but (CoolList a) or (CoolList Int) is!
-- Note 2: This datatype is recursive - A non-empty list is represented as the first element,
-- plus the rest of the list (i.e. [1,2,3,4,5] is just syntactic sugar for 1:2:3:4:5:[])
data CoolList a = Empty
                | Cons a (CoolList a)
                deriving (Show)

-- Our old friend; applying a doubling function to each element of the list.
-- We pattern match both cases of the CoolList (Empty and Cons), and in the
-- recursive case (Cons), we call doubleList recursively.
doubleList :: (CoolList Int) -> (CoolList Int)
doubleList Empty       = Empty
doubleList (Cons x xs) = Cons (x * 2) (doubleList xs)

-- A tree datatype. Looks an awful lot like a list, huh?
data Tree a = EmptyTree
            | Node a (Tree a) (Tree a)
            deriving (Show)

-- Doubling every element in a tree of ints exhibits the same structure as
-- doubling every element in a list
doubleTree :: (Tree Int) -> (Tree Int)
doubleTree EmptyTree           = EmptyTree
doubleTree (Node x left right) =
    Node (x * 2) (doubleTree left) (doubleTree right)

-- Just as 'map' exists for lists, you could write a 'treeMap' to map an arbitrary
-- function over a tree. Put a pin in that...
-- treeMap :: (a -> b) -> (Tree a) -> (Tree b)

-- More functions with trees; turn a tree into a list! Different ways to go about it.
flatten :: Tree a -> [a]
flatten EmptyTree = []
flatten (Node x left right) = x:(flatten left) ++ (flatten right)

-- Turn a list back into trees.
-- Food for thought: are 'flatten' and 'treeify' inverses?
-- That is, does (flatten . treeify) == id?
treeify :: [a] -> Tree a
treeify [] = EmptyTree
treeify (x:xs) = Node x (treeify l) (treeify r)
    where
        (l, r) = splitAt (length xs `div` 2) xs

-- Perhaps the most useful polymorphic, non-recursive datatype: Maybe
-- Used to represent the possibility of failure
-- Commented out because Maybe is already defined like so in GHC.
-- data Maybe a = Nothing
--              | Just a
--              deriving (Show)

-- You can implement a safer version of 'head' with Maybe that doesn't throw an exception.
safehead :: [a] -> Maybe a
safehead (x:_) = Just x
safehead []    = Nothing

-- A frequent form when working with data in Maybes
-- case m of
--     Nothing ->
--     Just v -> -- Make use of v

-- Type aliases work with type variables too!
-- We can represent a dictionary (albeit inefficiently) as a list of (key, value) pairs
type Dictionary k v = [(k, v)]

-- Using Maybe to look up a key in a dictionary when it may not be there
lookup' :: (Eq a) => Dictionary a b -> a -> Maybe b
lookup' []          _ = Nothing
lookup' ((k',v):xs) k
    | k == k'   = Just v
    | otherwise = lookup' xs k

-- Another useful polymorphic datatype: Either! Usually used for computations that
-- can possibly fail (like Maybe), but with accompanying error information.
-- Note that we have two type variables: Either is (* -> * -> *)
-- Commented out because Either is already defined like so in GHC.
-- data Either a b = Left a
--                 | Right b

-- Our ServerResponse from earlier is a good candidate for an Either type
-- type ServerResponse = Either Int HTML

-- A frequent form when working with Eithers
-- case m of
--     Left e  -> error e
--     Right v -> -- Make use of v

-- Records: when you want to give names to constructor fields
data Person = Person { 
    firstName :: String, 
    lastName :: String, 
    age :: Int, 
    phoneNumber :: String, 
    flavor :: String }
    deriving (Show)

-- We can still do our usual pattern matching (line 146), but we can also
-- use the fieldNames as "accessor" functions to grab that field from the data (line 147)
getFullName :: Person -> String
-- getFullName (Person fn ln _ _ _) = fn ++ ' ' : ln
getFullName p = firstName p ++ " " ++ lastName p

-- RecordWildCards: with the language extension turned on, we can
-- let a record datatype be "filled in" by variables in scope with the same name as the accessor.
maxwell :: Person
maxwell = 
    let
        firstName = "max"
        lastName = "levatich"
        age = 27
        phoneNumber = "xxx"
    in
        Person {flavor = "mint chip", ..}

-- Typeclasses! Grouping together types that all implement a set of shared functions.
-- Here's how you can define a typeclass. Commented out because (Eq) is already defined by GHC.
-- class Eq a where
--   (==) :: a -> a -> Bool
--   (/=) :: a -> a -> Bool

-- An instance of Eq for Cooleans. If we don't want to write this, we can use "derived (Eq)" in
-- the datatype definition (line 15) to get the "natural" implementation of Eq
-- Now we can use (==) and (/=) for Cooleans: CoolTrue == CoolFalse
instance Eq Cool where
    (==) CoolTrue  CoolTrue  = True
    (==) CoolFalse CoolFalse = True
    (==) _ _ = False

-- An instance of Eq for Maybes, commented out because Maybe already has an instance for Eq.
-- Note the type constraint! "Maybe" is not an instance of Eq, because Maybe isn't a type. Rather,
-- "Maybe a" is an instance of Eq for each type "a" that is an instance of Eq.
-- instance (Eq a) => Eq (Maybe a) where
--     (==) Nothing  Nothing  = True
--     (==) Nothing  (Just _) = False
--     (==) (Just _) Nothing  = False
--     (==) (Just x) (Just y) = x == y

-- An instance of Eq for trees. Note the recursive definition.
instance (Eq a) => Eq (Tree a) where
    (==) :: Tree a -> Tree a -> Bool
    (==) EmptyTree EmptyTree = True
    (==) (Node x l1 r1) (Node y l2 r2) =
        (x == y) && (l1 == l2) && (r1 == r2)
    (==) _ _ = False

-- Another simple typeclass definition: Ord. Note the type constraint.
-- For a type to be Ord (comparable for greater than/less than),
-- it must also be Eq (comparable for equality).
-- Note the "MINIMAL compare": we only need to implement compare (or <=), and GHC will infer the rest.
-- class Eq a => Ord a where
--   compare :: a -> a -> Ordering
--   (<) :: a -> a -> Bool
--   (<=) :: a -> a -> Bool
--   (>) :: a -> a -> Bool
--   (>=) :: a -> a -> Bool
--   max :: a -> a -> a
--   min :: a -> a -> a
--   {-# MINIMAL compare | (<=) #-}

-- An instance of Ord for Cooleans.
-- Whether CoolTrue > CoolFalse or CoolFalse > CoolTrue is up to us!
instance Ord Cool where
    compare :: Cool -> Cool -> Ordering
    compare CoolTrue  CoolTrue  = EQ
    compare CoolTrue  CoolFalse = LT
    compare CoolFalse CoolTrue  = GT
    compare _ _ = EQ

-- The instance of Ord for (Maybe a). Again, requires that "a" be Ord.
-- instance (Ord a) => Ord (Maybe a) where
--     compare Nothing Nothing   = EQ
--     compare Nothing (Just _)  = LT
--     compare (Just _) Nothing  = GT
--     compare (Just x) (Just y) = compare x y

-- An instance of Ord for trees.
instance (Ord a) => Ord (Tree a) where
    compare EmptyTree EmptyTree = EQ
    compare EmptyTree _         = LT
    compare _         EmptyTree = GT
    compare (Node x l1 r1) (Node y l2 r2) =
        case (compare x y) of
            EQ -> 
                case (compare l1 l2) of
                    EQ -> compare r1 r2
                    r -> r
            r -> r

-- We can make our own typeclasses, with whatever functions we want!
class Munchable a where
    munch :: a -> String

-- ...And instances for those typeclasses.
instance Munchable Int where
    munch _ = "hello"

-- Putting stuff together:
-- Here a few recursive datatypes that characterize a simple
-- programming language. We'll be expanding on this and changing it
-- as we go.
data Op = Plus | Mult | Sub deriving (Eq, Show)

-- Arithmetic expressions
data AExpr = BinOp AExpr Op AExpr
           | Neg   AExpr
           | Literal Int
           deriving (Eq, Show)

-- A function that evaluates an arithmetic expression to produce an Int
eval :: AExpr -> Int
eval (BinOp e1 op e2) =
    case op of
        Plus -> e1' + e2'
        Mult -> e1' * e2'
        Sub  -> e1' - e2'
    where
        e1' = eval e1
        e2' = eval e2
eval (Neg     e) = negate $ eval e
eval (Literal i) = i

-- Boolean expressions
data BExpr = BTrue
           | BFalse
           | BAnd BExpr BExpr
           | BOr  BExpr BExpr
           | BNot BExpr
           | BEq  AExpr AExpr
           | BNeq AExpr AExpr
           | BLt  AExpr AExpr
           | BGt  AExpr AExpr
           deriving (Eq, Show)

-- A Program is a statement
type Program = Statement

-- A statement is assignment, if-then-else, a while loop, or a sequence of two Statements. 
-- (allows arbitrary chains of statements, like "s1; s2")
data Statement = SAssign String AExpr
               | SIf     BExpr Statement Statement
               | SWhile  BExpr Statement
               | SSeq Statement Statement
               deriving (Eq, Show)

-- If we provide corresponding 'eval' functions (line 256) for BExprs and Statements,
-- we've written an interpreter for a little programming language!


-- We can hijack the Num typeclass to let us use numerical operators to construct
-- AExprs.
instance Num AExpr where
    (+) e1 e2 = BinOp e1 Plus e2
    (-) e1 e2 = BinOp e1 Sub  e2
    (*) e1 e2 = BinOp e1 Mult e2
    negate e1 = Neg e1
    fromInteger i = Literal $ fromInteger i

    -- Don't do this! If you can't implement every function of a typeclass "sensibly",
    -- it's probably not a good fit for your datatype
    abs _ = error "you didn't implement this!!! booo"
    signum _ = error "you didn't implement this!!! booo :(("

-- We can write an instance of Show to control how AExprs are displayed,
-- but more often we prefer to derive Show and write a pretty-printing function seperately
-- Note how prettyPrint and eval share an extremely similar form, since they both operate on AExprs
prettyPrint :: AExpr -> String
prettyPrint (BinOp e1 op e2) = 
    case op of
        Plus -> e1' ++ " + " ++ e2'
        Mult -> e1' ++ " * " ++ e2'
        Sub  -> e1' ++ " - " ++ e2'
    where
        e1' = prettyPrint e1
        e2' = prettyPrint e2
prettyPrint (Neg e)      = "-(" ++ prettyPrint e ++ ")"
prettyPrint (Literal x) = show x -- x is an Int, which is a member of the Show typeclass.

-- Building up to Monads with Functors. The Functor typeclass expresses that
-- a datatype should be "mappable".
-- Note the type: (* -> *) -> Constraint. A Functor is a typeclass for types that take a type argument.
-- So a Maybe or a Tree can be a functor, but not an Int, or (Tree a).
-- fmap is minimal, so let's just worry about implementing that.

-- type Functor :: (* -> *) -> Constraint
-- class Functor f where
--   fmap :: (a -> b) -> f a -> f b
--   (<$) :: a -> f b -> f a
--   {-# MINIMAL fmap #-}

-- Lists are mappable via the Prelude function "map"
-- (which we implemented ourselves in the previous lecture code).
-- instance Functor [] where
--   fmap = map

-- A functor instance for Trees.
-- This is exactly the treeMap function we hypothesized earlier (line 74)
instance Functor Tree where
    fmap _ EmptyTree    = EmptyTree
    fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r)

-- Alternative implementation of doubleTree using fmap
-- doubleTree = fmap (*2)

-- We can write functions that are polymorphic on the data structure!
-- This function works on anything that's a Functor: Lists, Trees, Maybes, etc.
toLengths :: Functor f => f String -> f Int
toLengths = fmap length

-- Functor laws: make sure your functor instances obey these!
-- fmap id == id
-- fmap (f . g) == (fmap f) . (fmap g)