data Numlist = Empty | Cons Integer Numlist
                       deriving (Show)

len l = case l of
  Empty -> 0
  Cons _ r -> 1 + len r

list = Cons 1 (Cons 2 (Cons 3 Empty))
--

empty = (0, False)

-- In Haskell this works because cons is polymorphic

cons x r =  (1, (x,r))

list = cons 1 (cons 2 (cons 3 empty))
--

data Pair a b = Pair { first:: a, second:: b }
                deriving Show

empty = Pair 0 False

-- we still rely on polymorphism
cons x r = Pair 1  ( Pair x r )

list = cons 1 (cons 2 (cons 3 empty))
--

type Symbol = String

data FAE =
  Number Integer|
  Boolean Bool|
  Add FAE FAE|
  Sub FAE FAE|
  Id Symbol|
  Fun { funParam::Symbol, argType:: TE, funBody::FAE }|
  App { funExp::FAE, argExp::FAE}|
  If { testExp::FAE, thenExp::FAE, elseExp::FAE }
  deriving (Show, Eq)

data TE =
  NumTE | BoolTE | ArrowTE {arg :: TE, result :: TE}
                   deriving (Show,Eq)

data Type =
  NumT | BoolT |  ArrowT {argT :: Type, resultT :: Type}
                  deriving (Show,Eq)
data TypeBind =
  Bind  { bName :: Symbol, bType :: Type }

type TypeEnv = [TypeBind]


get_type name [] = error "free variable, no type"
get_type name (x:xs) | name == (bName x) = (bType x)
                     | otherwise = get_type name xs


parse_type NumTE = NumT
parse_type BoolTE = BoolT
parse_type (ArrowTE l r) = ArrowT (parse_type l) (parse_type r)

typecheck::FAE->TypeEnv->Type

typecheck (Number _) _ = NumT
typecheck (Boolean _) _ = BoolT
typecheck (Add l r) env =
  let
    ltype = typecheck l env
    rtype = typecheck r env
  in
   if ltype == NumT && rtype == NumT then NumT else error "num num!"

typecheck (Id name) env = get_type name env

typecheck (Fun name te body) env =
  let
    arg_type = parse_type te
  in
   ArrowT arg_type (typecheck body  $ Bind name arg_type : env)

typecheck (App fn arg) env =
  let
    fntype = typecheck fn env
    argtype = typecheck arg env
  in
   case fntype of
     ArrowT fnarg_type result_type |argtype==fnarg_type -> result_type
                                   |otherwise -> error "arg type mismatch"
     _ -> error "wth?"


result1 = typecheck (App (Fun "x" NumTE (Add (Id "x") (Number 12)))
                    (Add (Number 1) (Number 17)))
          []
--

pair a b = \x -> if x == 0 then a else b

first p = p 0

second p = p 1
--

data BillingInfo = CreditCard CardNumber CardHolder
                   Address
                 | CashOnDelivery
                 | Invoice CustomerID
                   deriving (Show)

type CardHolder = String
type CardNumber = String
type Address = [String]
--

data Fruit = Apple | Orange deriving (Show)
apple = "apple"
orange = "orange"

whichFruit :: String -> Fruit
whichFruit f = case f of
                 apple  -> Apple
                 orange -> Orange
--

foo = let firstDefinition = blah blah
          -- a comment-only line is treated as empty
                              continuation blah
          -- left, so this is a new definition
          secondDefinition = yada yada
                             continuation yada
      in whatever
--

(+)  Num a => a -> a -> a  Prelude  Addition
(-)  Num a => a -> a -> a  Prelude  Subtraction
(*)  Num a => a -> a -> a  Prelude  Multiplication
(/)  Fractional a => a -> a -> a  Prelude  Fractional division
(**)  Floating a => a -> a -> a  Prelude  Raise to the power of
  (^)  (Num a, Integral b) => a -> b -> a  Prelude  Raise a number to a non-negative, integral power
  (^^)  (Fractional a, Integral b) => a -> b -> a  Prelude  Raise a fractional number to any integral power
  (%)  Integral a => a -> a -> Ratio a  Data.Ratio  Ratio composition
  (.&.)  Bits a => a -> a -> a  Data.Bits  Bitwise and
  (.|.)  Bits a => a -> a -> a  Data.Bits  Bitwise or
  abs  Num a => a -> a  Prelude  Absolute value
  approxRational  RealFrac a => a -> a -> Rational  Data.Ratio  Approximate rational composition based on fractional numerators and denominators
  cos  Floating a => a -> a  Prelude  Cosine. Also provided are acos, cosh, and acosh, with the same type.
  div  Integral a => a -> a -> a  Prelude  Integer division always truncated down; see also quot
  fromInteger  Num a => Integer -> a  Prelude  Conversion from an Integer to any numeric type
  fromIntegral  (Integral a, Num b) => a -> b  Prelude  More general conversion from any Integral to any numeric type
  fromRational  Fractional a => Rational -> a  Prelude  Conversion from a Rational. May be lossy.
  log  Floating a => a -> a  Prelude  Natural logarithm
  logBase  Floating a => a -> a -> a  Prelude  Log with explicit base
  maxBound  Bounded a => a  Prelude  The maximum value of a bounded type
  minBound  Bounded a => a  Prelude  The minimum value of a bounded type
  mod  Integral a => a -> a -> a  Prelude  Integer modulus
  pi  Floating a => a  Prelude  Mathematical constant pi
  quot  Integral a => a -> a -> a  Prelude  Integer division; fractional part of quotient truncated towards zero
  recip  Fractional a => a -> a  Prelude  Reciprocal
  rem  Integral a => a -> a -> a  Prelude  Remainder of integer division
  round  (RealFrac a, Integral b) => a -> b  Prelude  Rounds to nearest integer
  shift  Bits a => a -> Int -> a  Bits  Shift left by the specified number of bits, which may be negative for a right shift.
  sin  Floating a => a -> a  Prelude  Sine. Also provided are asin, sinh, and asinh, with the same type.
  sqrt  Floating a => a -> a  Prelude  Square root
  tan  Floating a => a -> a  Prelude  Tangent. Also provided are atan, tanh, and atanh, with the same type.
  toInteger  Integral a => a -> Integer  Prelude  Convert any Integral to an Integer
  toRational  Real a => a -> Rational  Prelude  Convert losslessly to Rational
  truncate  (RealFrac a, Integral b) => a -> b  Prelude  Truncates number towards zero
  xor  Bits a => a -> a -> a  Data.Bits  Bitwise exclusive or
--

instance BasicEq3 Color where
    isEqual3 Red Red = True
    isEqual3 Green Green = True
    isEqual3 Blue Blue = True
    isEqual3 _ _ = False
--

data Fruit = Apple | Orange deriving (Show)
apple = "apple"
orange = "orange"

whichFruit :: String -> Fruit
whichFruit f = case f of
                 apple  -> Apple
                 orange -> Orange
whichFruit apple = Apple
whichFruit orange = Orange

ghci> whichFruit "orange"

--

fromMaybe defval wrapped =
    case wrapped of
      Nothing     -> defval
      Just value  -> value

escape c =  case c of
              '\xF06C' ->   "\\lambda"
              '\xF070' ->   "\\pi"
              '\xF0DE' -> "\\Rightarrow"
              '\xF0E1' ->   "\\langle"
              '\xF0F1' ->   "\\rangle"
              _        ->   [c]
--

ghci> :info (^)
(^) :: (Num a, Integral b) => a -> b -> a
   ...   -- Defined in GHC.Real
infixr 8 ^
--

data Fruit = Apple | Orange deriving (Show)
apple = "apple"
orange = "orange"
whichFruit :: String -> Fruit
whichFruit f = case f of
                 apple  -> Apple
                 orange -> Orange

whichFruit2 apple = Apple
whichFruit2 orange = Orange

--

data Maybe a = Nothing
             | Just a
               deriving (Eq, Ord, Read, Show)

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

 this won't work
bad_nodesAreSame (Node a _ _) (Node a _ _) = Just a
bad_nodesAreSame _            _            = Nothing

 Use guards
nodesAreSame (Node a _ _) (Node b _ _)
    | a == b     = Just a
nodesAreSame _ _ = Nothing

--

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

 An algebraic data type can have more than one value constructor.data Bool = False | True
--

myNot True  = False
myNot False = True
--

newOr a b = if a then a else b

test = newOr True (1/0 > 1)
--

escape c =  case c of
              '\xF06C' ->   "\\lambda"
              '\xF070' ->   "\\pi"
              '\xF073' ->   "\\sigma"
              '\xF0AE' ->   "\\rightarrow"
              '\xF0B4' -> "\\times"
              '\xF0C6' ->   "\\emptyset"
              '\xF0DE' -> "\\Rightarrow"
              '\xF0E0' -> "\\diamond"
              '\xF0E1' ->   "\\langle"
              '\xF0F1' ->   "\\rangle"
              _        ->   [c]

--

class BasicEq2 a where
    isEqual2    :: a -> a -> Bool
    isNotEqual2 :: a -> a -> Bool

  This ok, but do we really need to implement both?
class BasicEq3 a where
    isEqual3 :: a -> a -> Bool
    isEqual3 x y = not (isNotEqual3 x y)

    isNotEqual3 :: a -> a -> Bool
    isNotEqual3 x y = not (isEqual3 x y)

instance BasicEq3 Bool
--

instance JSON Bool where
    toJValue = JBool
    fromJValue (JBool b) = Right b
    fromJValue _ = Left "not a JSON boolean"
--

itemName = "Weighted Companion Cube"

--

lend amount balance =
    let
        reserve    = 100
        newBalance = balance - amount
    in
      if balance < reserve
      then Nothing
      else Just newBalance
--

customer1 = Customer 271828 "J.R. Hacker"
            ["255 Syntax Ct",
              "Milpitas, CA 95134",
             "USA"]
--

sumList (x:xs) = x + sumList xs
sumList []     = 0

 evaluate:sumList [1,2]

 recall[1,2] == (1:(2:[]))
--

  \texttt{a}  is a \emph{type variable} \\data Maybe a = Just a
             | Nothing

someBool = Just True

someString = Just "something"

--

data CannotShow = CannotShow
                deriving (Show)

-- will not compile, since CannotShow is not an instance of Show
data CannotDeriveShow = CannotDeriveShow CannotShow
                        deriving (Show)

data OK = OK

instance Show OK where
    show _ = "OK"

data ThisWorks = ThisWorks OK
                 deriving (Show)

--

nicerID      (Book id _     _      ) = id
nicerTitle   (Book _  title _      ) = title
nicerAuthors (Book _  _     authors) = authors
--

myDrop n xs = if n <= 0 || null xs
              then xs
              else myDrop (n - 1) (tail xs)

niceDrop n xs | n <= 0 = xs
niceDrop _ []          = []
niceDrop n (_:xs)      = niceDrop (n - 1) xs
--

import SimpleJSON

result :: JValue
result = JObject [
  ("query", JString "awkward squad haskell"),
  ("estimatedCount", JNumber 3920),
  ("moreResults", JBool True),
  ("results", JArray [
     JObject [
      ("title", JString "Simon Peyton Jones: papers"),
      ("snippet", JString "Tackling the awkward ..."),
      ("url", JString "http://.../marktoberdorf/")
     ]])
  ]
--

main = do
        putStrLn "Please enter a Double:"
        inpStr <- getLine
        let inpDouble = (read inpStr)::Double
        putStrLn ("Twice " ++ show inpDouble ++ " is " ++ show (inpDouble * 2))
--

instance Show Color where
    show Red   = "Red"
    show Green = "Green"
    show Blue  = "Blue"
--

lend2 amount balance =
    if amount < reserve * 0.5
    then Just newBalance
    else Nothing
        where
          reserve    = 100
          newBalance = balance - amount
--

(*) 3 4 = 11
--

fromMaybe defval wrapped =
    case wrapped of
      Nothing     -> defval
      Just value  -> value
--

 Given the definitionisOdd n = mod n 2 == 1

 How is the expressionisOdd (2 + 1)
 evaluated?--

 Not recommended:bar =  let x = 1
       in ((let x = "foo" in x), x)

 So what is bar?--

class  Eq a  where
    (==), (/=) :: a -> a -> Bool

       -- Minimal complete definition:
       --     (==) or (/=)
    x /= y     =  not (x == y)
    x == y     =  not (x /= y)

--

foo =  let a = 1 in
       let b = 2 in a + b
--

data MagazineInfo = Magazine Int String [String]
                    deriving (Show)
--

-- file: ch06/JSONClass.hs
type JSONError = String

class JSON a where
    toJValue :: a -> JValue
    fromJValue :: JValue -> Either JSONError a

instance JSON JValue where
    toJValue = id
    fromJValue = Right
--

tidySecond :: [a] -> Maybe a
tidySecond (_:x:_) = Just x
tidySecond _       = Nothing
--

lend3 amount balance
    | amount <= 0            = Nothing
    | amount > reserve * 0.5 = Nothing
    | otherwise              = Just newBalance
    where reserve    = 100
          newBalance = balance - amount

 What is \texttt{otherwise}?
--

class BasicEq3 a where
    isEqual3 :: a -> a -> Bool
    isEqual3 x y = not (isNotEqual3 x y)

    isNotEqual3 :: a -> a -> Bool
    isNotEqual3 x y = not (isEqual3 x y)
--

data BookReview = BookReview BookInfo CustomerID
                  String
--

data BookInfo = Book Int String [String]
                deriving (Show)
--

 \texttt{type} synonyms, like \emph{typedef}type CustomerID = Int
type ReviewBody = String

data BetterReview = BetterReview BookInfo CustomerID
                    ReviewBody

 works for tuples and liststype BookRecord = (BookInfo, BookReview)
--

myDrop n xs =
    if n <= 0 ||
       null xs then xs
    else myDrop (n - 1)
             (tail xs)
--

type Identifier = String
type Value = Int

type Env = [(Identifier, Value)]

data WAE = Num Int
         | Add WAE WAE
         | Id Identifier
         | With Identifier WAE WAE
           deriving (Show)

interp :: WAE -> Env -> Value
interp (Num n) _ = n
interp (Add lhs rhs) env = interp lhs env
                           + interp rhs env
interp (Id i) env = lookupVar i env

interp (With bound_id named_expr bound_body) env =
  let
    substVal = (interp named_expr env)
  in
   interp bound_body   ( (bound_id,substVal):env )
lookupVar :: Identifier -> Env -> Value
lookupVar var ((i,v):r)
  | (var == i) = v
  | otherwise        = lookupVar var r


-- Make an infinitely deep environment stack
infEnv = map ( \x -> ("x", x) ) [1..]

-- Check lookup works
val = lookupVar "x" infEnv

-- Make an infinite program
program = tower tower
          where
            tower f = With "x" (tower f) (Num 1)

answer= interp program infEnv

--

data Color = Red | Green | Blue
     deriving (Read, Show, Eq, Ord)
--

ghci> 1 + (4 * 4)
17
ghci> 1 + 4 * 4
17
--

 indentation reveals scope \\bar = let b = 2
          c = True
      in let a = b
         in (a, c)
 Nested where's are an acquired taste. \\foo = x
    where
      x = y
          where
            y = 2
--

quux a = let a = "foo"
         in a ++ "eek!"

--

import Data.List
data Color=Red|Green|Blue deriving (Show)
instance Read Color where
    readsPrec _ value =
        tryParse [("Red", Red), ("Green", Green),
                                  ("Blue", Blue)]
        where
          tryParse [] = []
          tryParse ((attempt, result):xs)
              | isPrefixOf  attempt value  =
                  [(result, suffix)]
                  where
                    suffix=drop (length attempt) value
              |otherwise= tryParse xs
--

 There is no special \emph{null} in Haskell
simpleTree = Node "parent" (Node "left child"
                                 Empty Empty)
                           (Node "right child"
                                 Empty Empty)
--

data DataInt = D Int
    deriving (Eq, Ord, Show)

newtype NewtypeInt = N Int
    deriving (Eq, Ord, Show)
--

safeSecond :: [a] -> Maybe a
safeSecond [] = Nothing
safeSecond xs = if null (tail xs)
                then Nothing
                else Just (head (tail xs))
--

foo::(BasicEq3 a)=>a->a->a
foo p q = p

bar=foo True False--

 Suppose we have to implement our own equality operatordata Color = Red | Green | Blue

colorEq :: Color -> Color -> Bool
colorEq Red   Red   = True
colorEq Green Green = True
colorEq Blue  Blue  = True
colorEq _     _     = False

 It turns out we need to check strings for equality toostringEq [] [] = True
stringEq (x:xs) (y:ys) = x == y && stringEq xs ys
stringEq _ _ = False
 Wouldn't it be nice to have the same function name?--

pluralise :: String -> [Int] -> [String]
pluralise word counts = map plural counts
    where plural 0 = "no " ++ word ++ "s"
          plural 1 = "one " ++ word
          plural n = show n ++ " " ++ word ++ "s"
--

third (a, b, c) = c

complicated (True, a, x:xs, 5) = (a, xs)

ghci> complicated (True, 1, [1,2,3], 5)


--

bad_nodesAreSame (Node a _ _) (Node a _ _) = Just a
bad_nodesAreSame _            _            = Nothing
--

-- This is the leftmost column.
    -- Our first declaration is in column 4.
    firstBadIndentation = 1

  -- Our second is left of the first, fail!
  secondBadIndentation = 2
--

data Maybe a = Just a
             | Nothing
--

-- This is the leftmost column.
  -- top-level decl's can start in any column...
  firstGoodIndentation = 1
  -- ...provided all subsequent declarations do, too!
  secondGoodIndentation = 2
--

 With indentation \\bar = let a = 1
          b = 2
          c = 3
      in a + b + c

 With braces, and indentation ignored\\foo = let { a = 1;  b = 2;
       c = 3 }
   in a + b + c
--

 apply the \emph{Book} constructor to the values 9, "Close Calls", and ["John Long"]book= Book 9 "Close Calls" ["John Long"]

 pattern matching does the same in reversefoo (Book id name authors) =
 $\dots$    --

data Roygbiv =
    Red | Orange | Yellow
        | Green | Blue
        | Indigo | Violet
          deriving (Eq, Show)
--

{-# LANGUAGE TypeSynonymInstances #-}

instance JSON String where
    toJValue               = JString

    fromJValue (JString s) = Right s
    fromJValue _           = Left "not a JSON string"
--

data List a = Cons a (List a)
            | Nil
              deriving (Show)
ghci> Nil
Nil
ghci> Cons 0 Nil
Cons 0 Nil
ghci> Cons 1 it
Cons 1 (Cons 0 Nil)
ghci> Cons 2 it
Cons 2 (Cons 1 (Cons 0 Nil))

--

four = (+) 2 2

(*-) a b = a * (-b)--

myInfo = Book 9780135072455 "Algebra of Programming"
         ["Richard Bird", "Oege de Moor"]
--

class BasicEq a where
    isEqual :: a -> a -> Bool
--

newtype UniqueID = UniqueID Int
    deriving (Eq)

j::Int

j=3

k::UniqueID

k=j
--

data BookInfo = Book Int String [String]
                deriving (Show)
--

customer2 = Customer {
              customerID = 271828,
              customerAddress = ["10486 Disk Dr.",
                                 "Milpitas, CA",
                     "USA"],
  customerName = "Jane Q. Citizen"  }
--

type Vector = (Double, Double)

data Shape =
    Circle Vector Double
        | Poly [Vector]
--

So I spent a couple hours editing Haskell. So of course I had to spend at least that long customizing emacs. My particular interest is in so called literate haskell code that intersperses LaTeX and Haskell.

The first step is to install haskell-mode and mmm-mode.

apt-get install haskell-mode mmm-mode

Next, add something like the following to your .emacs

(load-library "haskell-site-file")
;; Literate Haskell [requires MMM]
(require 'mmm-auto)
(require 'mmm-haskell)
(setq mmm-global-mode 'maybe)
(add-to-list 'mmm-mode-ext-classes-alist
   '(latex-mode "\\.lhs$" haskell))

Now I want to think about these files as LaTeX with bits of Haskell in them, so I tell auctex that .lhs files belong to it (also in .emacs)

(add-to-list 'auto-mode-alist '("\\.lhs\\'" . latex-mode))
(eval-after-load "tex"
'(progn
    (add-to-list 'LaTeX-command-style '("lhs" "lhslatex"))
    (add-to-list 'TeX-file-extensions "lhs")))

In order that the

 \begin{code}
 \end{code}

environment is typeset nicely, I want any latex file that uses the style lhs to be processed with the script lhslatex (hence the messing with LaTeX-command-style). At the moment I just have an empty lhs.sty, but in principle it could contain useful definitions, e.g. the output from lhs2TeX on a file containing only

%include polycode.fmt

The current version of lhslatex is a bit crude. In particular it assumes you want to run pdflatex.

The upshot is that you can use AUCTeX mode in the LaTeX part of the buffer (i.e. TeX your buffer) and haskell mode in the \begin{code}\end{code} blocks (i.e. evaluate the same buffer as Haskell).