okabe-yuya / entry_haskell_programming Goto Github PK

doublePlusTwo x = doubleX + 2
  where doubleX = x * 2

add10 n = (\n -> n + 10) n
-- add10 1 -> 11 ※20とはならない

inc n = n + 1
inc 2 * 3
-- 3 * 3 = 9

-- 関数を引数に
ifEven myFunc x = if then x
                  then myFunc x
                  else x

inc n = n + 1
double n = n * 2
square n = n ^ 2

ifEvenInc n = ifEven inc n
ifEvenDouble n = ifEven double n
ifEvenSquare n = ifEven square n

getLocationFunction location = case location of
  "ny" -> nyFunc
  "sf" -> sfFunf
  "reno" -> renoFunc
  _ -> otherFunc

nyFunc x = ....
sfFunf x = ....
renoFunc x = ....
otherFunc x = ....

add x y z = x * y * z
add1 = add 1
add1 3 4

addressLetter name location = locationFunction name
  where locationFunction = getLocationFunction location

addressLetterV2 = flipBinaryArgs addressLetter
addressLetterNY = addressLetterV2 "ny"
*Main> addressLetterNY ("Bob", "Smith")

catAt1 n = "cat" !! n
catAt2 = (!!) "cat"
catAt3 = (!! 2) -- 右オペランドの部分適応がされて左オペランドの値を待機する
-- catAt3 "cat"

elem 'c' "cat"
'c' `elem` "cat"

-- eg: listの抽出
lst = [1,2,3]
head lst -- 1
next = tail lst -- [2, 3]

-- next
head next -- 2
tail -- [3]

tail (x:xs) = xs
tail [] = []

myCycle (x:xs) = x:myCycle (x:xs)

myReverse [] = []
myReverse (x:xs) = (myReverse xs) ++ [x]

-- eg: args (+) 0 [1,2,3,4,5]
myFoldr (+) 0 (1:[2,3,4,5]) = (+) next 1
next = myFoldr (+) 0 [2,3,4,5]

myFoldr (+) 0 [2,3,4,5] = (+) next 2
next = myFoldr (+) 0 [3,4,5]

myFoldr (+) 0 [3,4,5] = (+) next 3
next = myFoldr (+) 0 [4,5]

myFoldr (+) 0 [4,5] = (+) next 4
next = myFoldr (+) 0 [5]

myFoldr (+) 0 [5] = (+) next 5
next = myFoldr (+) 0 []

myFoldr (+) 0 [] = 0

0 + 5 + 4 + 3 + 2 + 1 という順序で処理が実行される

zip (cycle [1.0]) [1.0, 2.0 ..]
-- [1.0]を作り続ける無限リスト
-- [1.0, 2.0, 3.0, 4.0...]のように+1.0ずつを作り続ける無限リスト

cup flOz = \message -> message flOz
getOz aCup = aCup (\flOz -> flOz)
-- Oz -> オンスのこと(単位)

coffeeCup = cup 12
-- \message -> message 12
getOz coffeeCup
-- getOz \message -> message 12 = \message -> message 12 (\flOz -> flOz)
-- getOz \message -> message 12 = \flOz -> flOz 12
-- 12がmessage経由で受け取った関数の引数に格納されるため、値の取得が出来る 

ifEven :: (Int -> Int) -> Int -> Int
ifEven f n = if even n
              then f n
              else n

simple :: a -> b -> c -> Int
simple a b n = ....

simple :: a -> b -> a -> Int
simple a b n = ....

filter :: (a -> Bool) -> [a] -> [a]

myFoldl :: (a -> b) -> b -> [a] -> b
myFoldl :: (a -> b -> a) -> a -> [b] -> a -- 正解はこれ！おしい！

type FirtName = String
type LastName = String

fullName :: FirstName -> LastName -> [Char]

data RhType = Pos | Neg
data ABOType = A | B | AB | O

showRh :: RhType -> String
showRh Pos = "+"
showRh Neg = "-"

showABO :: ABOType -> String 
showABO A = "A"
showABO B = "B"
showABO AB = "AB"
showABO O = "O"

-- type constructor -> 複数の型を組み合わせる際には必要
data BloodType = BloodType ABOType RhType
showBloodType :: BloodType -> String
showBloodType (BloodType abo rh) = showABO abo ++ showRh rh

:info Num
class Num a where
  (+) :: a -> a -> a
  (-) :: a -> a -> a
  (*) :: a -> a -> a

-- クラスのインスタンスの自動生成
data Someone = A | B deriving (Show)

data SixSideDie = S1 | S2 | S3 | S4 | S5 | S6 deriving (Eq, Ord)

-- 独自の振る舞いを定義することが出来る
instance Show SixSideDie where
  show S1 = "Ⅰ"
  show S2 = "Ⅱ"
  show S3 = "Ⅲ"
  show S4 = "Ⅳ"
  show S5 = "Ⅴ"
  show S6 = "Ⅵ"

data SixSideDie = S1 | S2 | S3 | S4 | S5 | S6 deriving (Eq, Ord)
instance Eq SixSideDie where
  (==) S6 S6 = True
  (==) S5 S5 = True
  (==) S4 S4 = True
  (==) S3 S3 = True
  (==) S2 S2 = True
  (==) S1 S1 = True
  (==) _ _ = False

-- いまさらだけど
sample1 = One
sample2 = Two

class Eq a => Ord a where
  compare :: a -> a -> Ordering
  :
  :

-- EnumとEqがスーパークラス
class (Enum a, Eq a) => Die a where
  roll :: Int -> a

class (Enum a, Eq a) => Die a where
  roll :: Int -> a

instance Die FiveSideDie where
  roll n = toEnum (n `mod` 5)

data StoreItem = BookItem Book
                  | RecordItem VinylRecord
                  | ToyItem CollectibleToy
                  | PamphletItem Pamphlet

data Phamplet = Phamplet {
  title :: String,
  description :: String,
  contact :: String,
  phampletPrice :: Double,
}

myLast :: [a] -> a
-- myLastにて引数を受け取って関数に受け渡す記述が必要なくなる
myLast = head . reverse

myFunc a b | a == b = "goodmorning" | otherwise "hello"

mconcat [coin, coin, coin]
heads-heads-heads | 0.125
heads-heads-tails | 0.125
heads-tails-heads | 0.125
heads-tails-tails | 0.125
tails-heads-heads | 0.125
tails-heads-tails | 0.125
tails-tails-heads | 0.125
tails-tails-tails | 0.125

data Color = Red | Yellow | Blue | Green | Purple | Orange | Brown | Clear deriving (Show, Eq)
instance Semigroup Color where
  (<>) Clear any = any
  (<>) any Clear = any
  :
  :

instance Monoid Color where
  mempty = Clear
  mappend c1 c2 = c1 <> c2

data Maybe = Nothing | Just a

nothings :: [Maybe Organ] -> Int
nothings organs = length ((filter \x -> x == Nothing) organs)

data TS a = TS [Int] [Maybe a]

IO () -- () は空のタプル。IOへのパラメーター

main :: IO ()
main = do

:info putStrLn
putStrLn :: String -> IO ()     -- Defined in ‘System.IO’

calc :: [String] -> Int
calc (val1:"+":val2:_) = read val1 + read val2
calc (val1:"*":val2:_) = read val1 * read val2

{-# LANGUAGE extension #-}

import System.IO

main :: IO ()
main = do
  file <- openFile "hoge.txt" ReadMode
  input <- hGetContents file
  hClose fiie -- closeは直ちに実行されるためfileへの参照が無くなる(参照という言葉が正確かは不明)

  putStrLn input -- すでにcloseされてしまっているためエラーとなる -> 遅延評価のため、ここにきて初めてinputは評価される

sample :: Maybe Int
sample = Just 999

plus1 :: Int -> Int
plus1 n = n + 1

fmap plus1 sample -- Just 1000

instance Functor Maybe where
  fmap func (Just n) = Just (func n)
  fmap func Nothing = Nothing

successStr :: Maybe String
successStr = show <$> (Just 6)

-- Main> successStr
-- Just "6"

action :: IO Int -> IO String
action ioInt = fmap show ioInt

haversineMaybe :: Maybe LatLong -> Maybe LatLong -> Maybe Double
haversineMaybe Nothing _ = Nothing
haversineMaybe _ Nothing = Nothing
haversineMaybe (Just l1) (Just l2) = Just(haversine l1 l2)

fmap :: (a -> b) -> f a -> f b
applicative :: f (a -> b) -> f a -> f b

start = Map.lookup "Carcosa" locationDB
end = Map.lookup "Innsmouth" locationDB
haversine <$> start <*> end

-- haversine <$> start は部分適応がされてMaybe Doubleが返る
-- partialHaversine :: Maybe Double -> Maybe Double
-- partialHaversine <$> end と同じ状態になる

haversineIO :: IO LatLong -> IO LatLong -> IO Double
haversineIO v1 v2 = do
  val1 <- v1
  val2 <- v2
  let distance = haversine val1 val2
  return distance

haversineIO2 :: IO LatLong -> IO LatLong -> IO Double
haversineIO2 v1 v2 = haversine <$> v1 <*> v2

*Main T> :info <*>
type Applicative :: (* -> *) -> Constraint
class Functor f => Applicative f where
  ...
  (<*>) :: f (a -> b) -> f a -> f b
  ...

class Functor f => Applicative f where
  pure :: a -> f a

*Main> :t pure "Hello World!" :: IO String
:: IO String

*Main> fmap (+) [1000, 2000, 3000] <*> [500, 20000]
[1500,21000,2500,22000,3500,23000]

*Main> (+) <$> [1000, 2000, 3000] <*> [500, 2000]
[1500,3000,2500,4000,3500,5000]

*Main> pure (+) <*> [1000, 2000, 3000] <*> [500, 20000]
[1500,21000,2500,22000,3500,23000]

*Main> :t pure (+)
pure (+) :: (Prelude.Applicative f, Num a) => f (a -> a -> a)

(+) -- 決定論
pure (+) -- 非決定論

type UserName = String
type PlayerCredits = Int

Maybe UserName -> (UserName -> Maybe PlayerCredits) -> Maybe PlayerCredits

(<$>) :: Functor f => (a -> b) -> f a -> f b
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
pure :: Applicative f => a -> f a

altLookupCredits :: Maybe UserName -> Maybe PlayerCredits
altLookupCredits Nothing = Nothing
altLookupCredits (Just name) = lookupCredits name

(>>=) :: Monad m => m a -> (a -> m b) -> m b

lookupUserName :: GamerId -> Maybe UserName
lookupUserName id = Map.lookup id userNameDB

lookupCredits :: UserName -> Maybe PlayerCredits
lookupCredits name = Map.lookup name creditDB

monadCreditsFromId :: GamerId -> Maybe PlayerCredits
monadCreditsFromId id = lookupUserName id >>= lookupCredits

(>>=) :: m a -> (a -> m b) -> m b -- コンテキストから取り出した値を関数に適応させる
(>>) :: m a -> m b -> m b -- 一つ目の引数のコンテキストを破棄する eg: putStrLn >> getLine
return :: a -> m a -- Applicativeのpureと同じ。歴史的背景から別名が付いている

helloPerson :: String -> String
helloPerson name = mconcat ["Hello ", name, "!"]

main :: IO ()
main = do
  name <- getLine
  let statement = helloPerson name
  putStrLn statement

main :: IO ()
main = do
  getLine >>= (\name -> (\statement -> putStrLn statement) (helloPerson name))

-- 自分的にはこちらの方が無名関数をネストするよりは分かりやすい
main :: IO ()
main = do
  getLine >>= (\name -> return (helloPerson name)) >>= (\statement -> putStrLn statement)

echo :: IO ()
echo = getLine  >>= putStrLn

main :: IO ()
main = do
  input <- getLine
  putStrLn input

list :: [Int]
list = [1,2,3,4,5]

doubler :: Int -> Int
doubler n = n * 2

doublerList :: [Int] -> [Int]
doublerList list = do
  val <- list
  let applied = doubler val
  return applied

powersOfTwo :: Int -> [Int]
powersOfTwo n = do
  value <- [ 1..n ]
  return (2 ^ value)

import Control.Monad

filterGuard :: (a -> Bool) -> [a] -> [a]
filterGuard func lst = do
  value <- lst
  guard(func value)
  return value

powersOfTwo2 :: Int -> [Int]
powersOfTwo2 n = [2 ^ value | value <- [1 .. n]]

-- _select :: (a -> b) -> [a] -> [b]
_select :: Monad m => (a -> b) -> m a -> m b
_select prop vals = do prop <$> vals

data HINQ m a b = HINQ (m a -> m b) (m a) (m a -> m a) | HINQ_ (m a -> m b) (m a)

query1 :: HINQ [] (Teacher, Course) Name

HINQ ([a] -> [b]) ([a]) ([a] -> [a])

([a] -> [b]) -- SELECT
([a]) -- FROM
([a] -> [a]) -- WHERE

module Main where

import Data.Char (toLower, isSpace, isPunctuation)

stack ghc Main.hs