FP_HSE2020Fall_05

Fp05.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Fp05 where
import Data.List ( find )

-- Значение незавершающегося вычисления
bot :: Bool
bot = not bot
{-
GHCi> :set -fprint-explicit-foralls
GHCi> :t undefined 
undefined :: forall {a}. a
GHCi> :t error
error :: forall {a}. [Char] -> a
-}

-- Нестрогая функция
ignore x  = 42
{-
GHCi> ignore undefined
42
GHCi> ignore bot
42
-}

-- Пример использования seq
factorial n = helper 1 n where 
  helper acc k | k > 1 = helper (acc * k) (k - 1)
               | otherwise = acc

factorial' n = helper 1 n where 
  helper acc k | k > 1 = (helper $! acc * k) (k - 1)
               | otherwise = acc


-- Сопоставление с образцом (pattern matching)

-- переставляет элементы пары местами (определена в Data.Tuple)
swap         :: (a,b) -> (b,a)
swap (x,y)    = (y,x)

-- перечисление
data CardinalDirection = North | East | South | West
    deriving Show

hasPole :: CardinalDirection -> Bool
hasPole North = True
hasPole South = True
hasPole _     = False  -- Wild-card

isAnswer :: Integer -> Bool
isAnswer 42 = True
isAnswer _  = False

bar (1, 2) = 3
bar (0, _) = 5


-- декартово произведение
data PointDouble = PtD Double Double 
  deriving Show

midPointDouble :: PointDouble -> PointDouble -> PointDouble
midPointDouble (PtD x1 y1) (PtD x2 y2) = PtD ((x1 + x2) / 2) ((y1 + y2) / 2)


-- полиморфные типы
data Point a = Pt a a 
  deriving Show

midPoint :: Fractional a => Point a -> Point a -> Point a
midPoint (Pt x1 y1) (Pt x2 y2) = Pt ((x1 + x2) / 2) ((y1 + y2) / 2)

-- стандартные алгебраические типы
head'          :: [a] -> Either String a
head' (x:_)    =  Right x
head' []       =  Left "head''': empty list"

-- экспоненциальные типы
data Endom a = Endom (a -> a)

appEndom :: Endom a -> a -> a
appEndom (Endom f) = f

-- рекурсивные типы
data List a = Nil | Cons a (List a)  
  deriving Show

len :: List a -> Int
len (Cons _ xs) = 1 + len xs
len  Nil        = 0


-- выражение case ... of ...
head'' xs = case xs of
  (x:_) -> x
  []    -> error "head': empty list"

-- As-образец
dupFirst            :: [a] -> [a]
dupFirst (x:xs)     =  x:x:xs

dupFirst'           :: [a] -> [a]
dupFirst' s@(x:xs)  =  x:s

-- ленивые образцы
(***) f g ~(x, y) = (f x, g y)
-- (***) f g p = let (x, y) = p in (f x, g y) -- тоже подойдет

-- образцы в лямбде  
head''' = \(x:_) -> x

-- охранные образцы (pattern guards)
firstOdd :: [Integer] -> Integer
firstOdd xs | Just x <- find odd xs = x
            | otherwise             = 0
            
firstOddIsBig :: [Integer] -> Bool
firstOddIsBig xs 
  | Just x <- find odd xs, x > 1000 = True
  | otherwise                       = False


-- Метки полей (Field Labels)
data Point' a = Pt' { ptx :: a, pty :: a }  
  deriving Show

absP p = sqrt (ptx p ^ 2 + pty p ^ 2)

absP' (Pt' {ptx = x, pty = y}) = sqrt (x ^ 2 + y ^ 2)


data Homo = Known   {name :: String, male :: Bool} 
          | Unknown {male :: Bool}
{-
-- приведет к ошибке компиляции
data Bad = Bad {male :: Bool}
-}


-- Объявление newtype

newtype AgeNT = AgeNT Int

data    AgeDT = AgeDT Int

fNT (AgeNT n) = 42

fDT (AgeDT n) = 42

{-
GHCi> fNT undefined
42
GHCi> fDT undefined
*** Exception: Prelude.undefined
-}


-- Фантомные типы

{- Нужен GeneralizedNewtypeDeriving -}
newtype Temperature a = Temperature Double
  deriving (Num,Eq,Show)
  
data Celsius
data Fahrenheit 

comfortTemperature :: Temperature Celsius
comfortTemperature = Temperature 23

c2f :: Temperature Celsius -> Temperature Fahrenheit
c2f (Temperature c) = Temperature (1.8 * c + 32)

{-
GHCi> :t comfortTemperature
comfortTemperature :: Temperature Celsius
GHCi> comfortTemperature + Temperature 2
Temperature 25.0
GHCi> c2f comfortTemperature
Temperature 73.4
GHCi> :t c2f comfortTemperature
c2f comfortTemperature :: Temperature Fahrenheit
GHCi> c2f comfortTemperature - comfortTemperature
 error: Couldn't match type `Celsius' with `Fahrenheit'
-}