Haskell

ghci
>> :load -- ファイル読み込み
>> :reload -- 再読込。org-babelがおかしくなったときに使える
>> :quit -- ghci終了

:set prompt "GHCi> "

(+) 2 2

2 + (- 1)

:info (+)

:info (*)

pi

let e = exp 1
(e ** pi) - pi

["foo", "bar", "baz"]

[1..10]

[1.0,1.25..2.0]

[3,1,3] ++ [3,7]

1 : [2, 3]

Prelude> :set +t
Prelude> 'c'
'c'
it :: Char

Prelude> :unset +t

1.2 % 3.4

:type 1

:type "abc"

:type it

succ 6

pred 9

sin (pi / 2)

truncate pi

round 3.4

:?

:type 'a'
'a' :: Char

[1, 2, 3] :: Int

odd 3

odd 6

compare 3 3

compare 3 2

(compare 2 3) == LT
compare 2 3 == LT

compare (sqrt 3) (sqrt 6)

:type head
head [1,2,3,4]
head ['a','b','c']
tail [1,2,3,4]
tail [True,False]

-- 評価結果のBoolがリンクで解釈されてエクスポート時にエラーになるので再評価しない。
:type [[True],[False,False]]

:type [1, 'a']

(1964, "Labyrinths")
()

:type (True, "hello")

:type (4, ['a', 'm'], (16, True))

:type (False, 'a')

:type ('a', False)

:type (False, 'a')

take 2 [1,2,3,4,5]

drop 3 [1,2,3,4,5]

fst (1,'a')

snd (1,'a')

:type lines

lines "the quick\nbrown for\njumps"

:type readFile

add a b = a + b
add 1 2

drop 2 "foobar"
drop 4 "foobar"
drop 4 [1, 2]
drop 0 [1, 2]
drop 7 []
drop (-2) "foo"

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

myDrop 2 "foobar"
myDrop 4 "foobar"
myDrop 4 [1, 2]
myDrop 0 [1, 2]
myDrop 7 []
myDrop(-2) "foo"

:type null
:type (||)

isOdd n = mod n 2 == 1
isOdd 3

print (myDrop 2 "abcd")

:type 2 <= 0 || null "abcd"
null "abcd"

last [1,2,3]
last "baz"
:type last

:type fst

:type take

:type not

:{
data BookInfo = Book Int String [String]
                deriving (Show)
:}

:{
data MagazineInfo = Magazine Int String [String]
                    deriving (Show)
:}

:info BookInfo

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

type CustomerID = Int
type ReviewBody = String
data BetterReview = BetterReview BookInfo CustomerID ReviewBody

data Bool = False | True

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

:{
data BillingInfo = CreditCard CardNumber CardHolder Address
                   | CashOnDelivery
                   | Invoice CustomerID
                     deriving (Show)
:}
:info BillingInfo

:type CreditCard
CreditCard "2901650221064486" "Thomas Gradgrind"  ["Dickens", "England"]

:type it

:type Invoice
Invoice 2222

Book 2 "The Wealth of Networks" ["Yochai Benkler"]
(2, "The Wealth of Networks", ["Yochai Benkler"])

a = ("Porpoise", "Gray")
b = ("Table", "Oak")

data Cetacean = Cetacean String String
data Furniture = Furniture String String

c = Cetacean "Porpoise" "Gray"
d = Furniture "Table" "Oak"

:{
-- x, yの座標
data Cartesian2D = Cartesian2D Double Double
                   deriving (Eq, Show)

-- 偏角と長さ
data Polar2D = Polar2D Double Double
               deriving (Eq, Show)
:}

Cartesian2D (sqrt 2) (sqrt 2) == Polar2D (pi / 4) 2

(1, 2) == (1, 2)

struct book_info {
  int id;
  char *name;
  char **authors;
};

:{
data BookInfo = Book Int String [String]
                  deriving (Show)
:}

enum roygbiv {
  red,
  orange,
  yellow,
  green,
  blue,
  indigo,
  violet,
};

:{
data Roygbiv = Red
             | Orange
             | Yellow
             | Green
             | Blue
             | Indigo
             | Violet
               deriving (Eq, Show)
:}
:type Yellow
:type Red
Red == Yellow
Green == Green

take 3 "foobar"
take Red "foobar"

type Vector = (Double, Double)
:{
data Shape = Circle Vector Double
           | Poly [Vector]
:}
:info Shape

myNot True = False
myNot False = True

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

sum [1,2]

complicated (True, a, x:xs, 5) = (a, xs)
complicated (True, 1, [1,2,3], 5)

complicated (False, 1, [1,2,3], 5)

bookID (Book id title authors) = id
bookTitle (Book id title authors) = title
bookAuthors (Book id title authors) = authors

bookID (Book 3 "Probability Theory" ["E.T.H. Jaynes"])
bookTitle (Book 3 "Probability Theory" ["E.T.H. Jaynes"])
bookAuthors (Book 3 "Probability Theory" ["E.T.H. Jaynes"])

:type bookID
:type bookTitle
:type bookAuthors

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

goodExample (x:xs) = x + goodExample xs
goodExample _ = 0
goodExample []
goodExample [1, 2]

:{
  data Customer = Customer {
     customerID :: CustomerID
   , customerName :: String
   , customerAddress :: Address
     } deriving (Show)
:}
:type customerID

:{
customer2 = Customer {
    customerID = 271828
  , customerAddress = ["1048576 Disk Drive",
                      "Milpitas, CA 95134",
                      "USA"]
  , customerName = "Jane Q. Citizen"
  }
:}
customer2
cities

:type customerName
customerName customer2

:{
data Maybe a = Just a
             | Nothing
:}
:info Maybe

someBool = Just True
:type someBool
someString = Just "something"
:type someString
:type Just "Invisible bike"

wrapped = Just (Just "wrapped")
:type wrapped

:{
data List a = Cons a (List a)
            | Nil
              deriving (Show)
:}

Nil
Cons 0 Nil
Cons 1 it
Cons 2 it
Cons 3 it

:{
data Tree a = Node a (Tree a) (Tree a)
            | Empty
              deriving (Show)
:}

fromList (x:xs) = Cons x (fromList xs)
fromList [] = Nil
fromList "durian"
fromList [Just True, Nothing, Just False]

class Tree<A>
{
    A value;
    Tree<A> left;
    Tree<B> right;

    public Tree(A v, Tree<A> l, Tree<A> r)
    {
        value = v;
        left = l;
        right = r;
    }
}

class Example
{
    static Tree<String> simpleTree()
    {
        return new Tree<String>(
                                "parent",
                                new Tree<String>("left leaf", null, null),
                                new Tree<String>("right leaf", null, null));
    }
}

:{
simpleTree = Node "parent" (Node "left child" Empty Empty)
                           (Node "right child" Empty Empty)
:}
:type simpleTree

:{
mySecond :: [a] -> a
mySecond xs = if null (tail xs)
              then error ("list too short")
              else head (tail xs)
:}
mySecond "xi"
mySecond [2, 3]
mySecond [2]

:{
safeSecond :: [a] -> Maybe a
safeSecond [] = Nothing
safeSecond xs = if null (tail xs)
                then Nothing
                else Just (head (tail xs))
:}
safeSecond [1,2] -- なぜかできない。

tidySecond :: [a] -> Maybe a

tidySecond (_:x:_) = Just x
tidySecond _       = Nothing

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

:{
bar = let x = 1
      in ((let x = "foo" in x), x)
:}
bar

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

:{
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"
:}
pluralise "car" [0]
pluralise "car" [1]
pluralise "car" [2]

:{
fromMaybe defval wrapped =
  case wrapped of
    Nothing -> defval
    Just value -> value
:}

:{
  data Fruit = Apple | Orange
  betterFruit f = case f of
                  "apple" -> Apple
                  "orange" -> Orange
:}

:{
nodesAreSame (Node a _ _) (Node b _ _)
    | a == b     = Just a
nodesAreSame _ _ = Nothing
:}

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

:{
myDrop n xs = if n <= 0 || null xs
              then xs
              else myDrop (n - 1) (tail xs)
 :}
myDrop 2 "abcd"

:{
niceDrop n xs | n <= 0 = xs
niceDrop _ []          = []
niceDrop n (_:xs)      = niceDrop (n - 1) xs
:}
niceDrop 2 "abcd"

:type lines
lines "line 1\nline 2"
lines "foo\n\nbar\n"

break odd [2,4,5,6,8]
:module +Data.Char
break isUpper "isUpper"

:{
  a `plus` b = a + b
  data a `Pair` b = a `Pair` b
             deriving (Show)
  foo = Pair 1 2
  bar = True `Pair` "quux"
:}
1 `plus` 2
plus 1 2
Pair "a" "a"
"a" `Pair` "a"

:type length
length []
length [1,2,3]
null []
head [1,2]
tail "foo"
last "bar"

:type (++)
"foo" ++ "bar"
[] ++ [1,2,3]
[1] ++ []

:type concat
concat [[1,2,3], [4,5,6]]
concat [[[1,2],[3]], [[4],[5],[6]]]
concat (concat [[1,2],[3]], [[4],[5],[6]])

:type reverse
reverse "foo"

:type all
all odd [1,3,5]
all odd [3,1,4]
all odd []
:type any
any even [3,1,4]
any even []

:type take
take 3 "foobar"
take 2 [1]
:type drop
drop 3 "xyzzy"
drop 1 []

:type splitAt
splitAt 3 "foobar"

:type span
span even [2,4,6,7,9,10,11]
:type break
break even [1,3,5,6,8,9,10]

:type elem
2 `elem` [5,3,2,1,1]
2 `notElem` [5,3,2,1,1]

:type filter
 filter odd [2,4,1,3,6,8,5,7]

:module +Data.List
:type isPrefixOf
"foo" `isPrefixOf` "foobar"
[1,2] `isPrefixOf` []

:type zip
zip [12,72,93] "zippity"

:type zipWith
zipWith (+) [1,2,3] [4,5,6]

:{
  mySmartExample xs = if not (null xs)
                      then head xs
                      else 'Z'
  myOtherExample (x:_) = x
  myOtherExample [] = 'Z'
:}
mySmartExample "head"
mySmartExample []

lines "foo\nbar"
unlines ["foo", "bar"]

words "the \r quick \t brown\n\n\nfox"
unwords ["jumps", "over", "the", "lazy", "dog"]

int as_int(char *str)
{
  int acc;
  for (acc = 0; isdigit(*str); str++) {
    acc = acc * 10 + (*str - '0');
  }

  return acc;
}

void square(double *out, const double *in, size_t length)
{
  for (size_t i = 0; i < length; i++) {
    out[i] = in[i] * in[i];
  }
}

:{
 square :: [Double] -> [Double]
 square (x:xs) = x*x : square xs
 square []     = []
:}
square [1,2]
square []

:{
upperCase :: String -> String

upperCase (x:xs) = toUpper x : upperCase xs
upperCase []     = []
:}
upperCase "hello"

upperCase2 xs = map toUpper xs
upperCase2 "hello"

:{
  myMap :: (a -> b) -> [a] -> [b]
  myMap f (x:xs) = f x : myMap f xs
  myMap _ _      = []
:}
  upperCase3 xs = myMap toUpper xs
  upperCase3 "hello"

:{
oddList :: [Int] -> [Int]

oddList (x:xs) | odd x = x : oddList xs
               | otherwise = oddList xs
oddList _                  = []
:}
oddList [1,2,3,4,5,6,7,8,9,10]

:{
mySum xs = helper 0 xs
  where helper acc (x:xs) = helper (acc + x) xs
        helper acc _      = acc
:}
mySum [1,2,3,4]

:{
foldl :: (a -> b -> a) -> a -> [b] -> a

foldl step zero (x:xs) = foldl step (step zero x) xs
foldl _    zero []     = zero
:}

:{
niceSum :: [Integer] -> Integer
niceSum xs = foldl (+) 0 xs
:}
niceSum [1,2,3,4,5]

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr step zero (x:xs) = step x (foldr step zero xs)
foldr _    zero []     = 0

:{
filter :: (a -> Bool) -> [a] -> [a]
filter p [] = []
filter p (x:xs)
  | p x = x : filter p xs
  | otherwise = filter p xs
:}

:{
myFilter p xs = foldr step [] xs
  where step x ys | p x = x : ys
                  | otherwise = ys
:}
myFilter (+) [1,2]

:{
isInAny needle haystack = any inSequence haystack
    where inSequence s = needle `isInfixOf` s
:}

isInAny2 needle haystack = any (\s -> needle `isInfixOf` s) haystack

:type dropWhile

:type dropWhile
:type dropWhile isSpace
map (dropWhile isSpace) [" a", "f", "    e"]

:type zip3
zip3 "foo" "bar" "quux"

:type zip3 "foo"
let zip3foo = zip3 "foo"
:type zip3foo
zip3foo "aaa" "bbb"

isInAny3 needle haystack = any (isInfixOf needle) haystack

niceSum :: [Integer] -> Integer
niceSum xs = foldl (+) 0 xs

niceSum :: [Integer] -> Integer
niceSum = foldl (+) 0

(1+) 2
map (*3) [24,36]
map (2^) [3,5,7,9]

:type (`elem` ['a'..'z'])

(`elem` ['a'..'z']) 'a'
(`elem` [1..9]) 1
(`elem` [1..9]) 10

all (`elem` ['a'..'z']) "Frobozz"

isInAny4 needle haystack = any (needle `isInfixOf`) haystack
:type isInAny4

:m +Data.List
tail "foobar"
tail (tail "foobar")
tails "foobar"
tails []

:{
sufixes :: [a] -> [[a]]
sufixes xs@(_:xs') = xs : sufixes xs'
sufixes _          = []
:}
sufixes "foo"

init [1,2,3]

suffix2 xs = init (tails xs)
suffix2 [1,2,3]

:{
compose :: (b -> c) -> (a -> b) -> a -> c
compose f g x = f (g x)
suffixes3 xs = compose init tails xs
:}
suffixes3 [1,2,3]

suffixes4 = compose init tails
suffixes4 [1,2,3]

suffixes5 = init . tails
suffixes5 [1,2,3]

:type (.)

:type isUpper . head
isUpper 'W'

:type filter (isUpper . head)

:type words
words "#define DLT_CHAOS     5"

:type tail
tail ["#define","DLT_CHAOS","5"]

:type tail . words
(tail . words) "#define DLT_CHAOS           5"

:type head . tail . words
(head . tail . words) "#define DLT_CHAOS     5"

:{
foldl' _ zero []    = zero
foldl' step zero (x:xs) =
    let new = step zero x
    in new `seq` foldl' step new xs
:}

:type seq

foldl' (+) 1 (2:[])

:{
let new = 1 + 2
in new `seq` foldl' (+) new []
:}

fold' (+) 3 []

:{
data Color = Red | Green | Blue
colorEq :: Color -> Color -> Bool
colorEq Red Red = True
colorEq Green Green = True
colorEq Blue Blue = True
colorEq _ _ = False
:}

stringEq :: [Char] -> [Char] -> Bool
stringEq [] [] = True
stringEq (x:xs) (y:ys) = x == y && stringEq xs ys
stringEq _ _ = False

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

:type isEqual

:{
instance BasicEq Bool where
    isEqual True  True  = True
    isEqual False False = True
    isEqual _     _     = False
:}

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

:{
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)
:}

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

    -- 最低限の完全な定義は(==) か (/=) のどちらか
    x /= y     = not (x == y)
    x == y     = not (x /= y)

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

:type show

show 1
show [1,2,3]
show (1,2)

putStrLn (show 1)
putStrLn (show [1,2,3])

show "Hello!"
putStrLn (show "Hello!")
show ['H', 'i']
show "Hi, \"Jane\""
putStrLn (show "Hi, \"Jane\"")

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

:type read

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

read "5"

:type (read "5")

(read "5")::Integer
(read "5")::Double

:{
instance Read Color where
   readsPrec _ value =
       -- ペアは文字列と欲しい返り値
       tryParse [("Red", Red), ("Green", Green), ("Blue", Blue)]
       where tryParse [] = []
             tryParse ((attempt, result):xs) =
                 if (take (length attempt) value) == attempt
                    then [(result, drop (length attempt) value)]
                    else tryParse xs
:}

(read "Red")::Color
(read "Green")::Color
(read "Blue")::Color
(read "[Red]")::Color
(read "[Red,Red,Blue]")::Color

let d1 = [Just 5, Nothing, Nothing, Just 8, Just 9]::[Maybe Int]
:type show
:type show d1
putStrLn (show d1)

writeFile "test" (show d1)

input <- readFile "test"
let d2 = (read input) ::[Maybe Int]
print d1
print d2
d1 == d2

putStrLn $ show [("hi", 1), ("there", 3)]

putStrLn $ show [[1, 2, 3], [4, 0, 1], [], [503]]

putStrLn $ show [Left 5, Right "there", Left 0, Right "nine"]

putStrLn $ show [Left 0, Right [1, 2, 3], Left 5, Right []]

:{
data Color = Red | Green | Blue
       deriving (Read, Show, Eq, Ord)
:}
show Red
(read "Red")::Color
(read "[Red,Red,Blue]")::[Color]
(read "[Red, Red, Blue]")::[Color]
Red == Red
Red == Blue
Data.List.sort [Blue,Green,Blue,Red]
Red < Blue

:{
data CannotShow = CannotShow
data CannotDeriveShow = CannotDeriveShow CannotShow
                        deriving (Show)
:}

:{
data OK = OK
instance Show OK where
    show _ = "OK"
data ThisWorks = ThisWorks OK
                 deriving (Show)
:}

type JSONError = String

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

instance JSON JValue where
    toJValue = id
    fromJValue = Right

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

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

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

{-# LANGUAGE TypeSynonymInstances #-}

doubleToJValue :: (Double -> a) -> JValue -> Either JSONError a
doubleToJValue f (JNumber v) = Right (f v)
doubleToJValue _ _ = Left "not a JSON number"

instance JSON Int where
    toJValue = JNumber . realToFrac
    fromJValue = doubleToJValue round

instance JSON Integer where
    toJValue = JNumber . realToFrac
    fromJValue = doubleToJValue round

instance JSON Double where
    toJValue = JNumber
    fromJValue = doubleToJValue id

instance (JSON a) => JSON [a] where
    toJValue = undefined
    fromJValue = undefined

instance (JSON a) => JSON [(String, a)] where
    toJValue = undefined
    fromJValue = undefined

{-# LANGUAGE FlexibleInstances #-}
class Borked a where
    bork :: a -> String

instance Borked Int where
    bork = show

instance Borked (Int, Int) where
    bork (a, b) = bork a ++ ", " ++ bork b

instance (Borked a, Borked b) => Borked (a, b) where
    bork (a, b) = ">>" ++ bork a ++ " " ++ bork b ++ "<<"