Haskell — Говнокод.ру

Haskell / Говнокод #12056

−82

1
2
3
4
5
6
7

only :: (Integral nt) => nt -> [Bool]
only n = [ x `mod` n == 0 | x <- [0..] ]

each :: (Integral nt) => nt -> [a] -> [a]
each n xs = [ snd x | x <- filter fst $ zip (only n) xs ]

main = do print $ each 2 [1,2,3,4,5,6,7,8,9]

Haskell. Получение каждого n-го элемента списка.

Fai, 05 Ноября 2012

Комментарии (81)

Haskell / Говнокод #11976

−82

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

{-# LANGUAGE ExistentialQuantification,
             DeriveDataTypeable,
             PatternSignatures #-}

import Data.Typeable
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Concurrent.Chan

-- Core data types

data Message = forall t . Typeable t => Message t | StopMessage
    deriving Typeable

data Handler = forall t . Typeable t => Handler (t -> IO ())


-- Worker thread

data Worker = Worker (Chan Message) (MVar ())

workerThread :: [Handler] -> Chan Message -> MVar () -> IO ()
workerThread handlers chan finish = loop where
    loop = do
        message <- readChan chan
        case message of
            StopMessage -> putMVar finish ()
            Message val -> do
                foldr (tryHandler val) (putStrLn "Unhandled message") handlers
                loop
    tryHandler val (Handler h) rest = maybe rest h (cast val)

startWorker :: [Handler] -> IO Worker
startWorker handlers = do
    chan <- newChan
    finish <- newEmptyMVar
    forkIO (workerThread handlers chan finish)
    return $ Worker chan finish

send :: Typeable m => Worker -> m -> IO ()
send (Worker chan _) message = do
    writeChan chan $ Message message

stopWorker :: Worker -> IO ()
stopWorker (Worker chan finish) = do
    writeChan chan $ StopMessage
    takeMVar finish


-- Some tests

data Test = Test Bool String deriving Typeable

intHandler :: Int -> IO ()
intHandler val = putStrLn $ "Int: " ++ show (val * 2)

strHandler :: String -> IO ()
strHandler val = putStrLn $ "String: " ++ reverse val

testHandler :: Test -> IO ()
testHandler (Test b s) = putStrLn $ "Test: " ++ show b ++ " " ++ show s

main = do
    w <- startWorker [
        Handler intHandler,
        Handler (\(val::Char) -> putStrLn $ "Char: " ++ show val),
        Handler strHandler,
        Handler testHandler]
    send w (5::Int)
    send w False
    send w 'a'
    send w "foo"
    send w (Test True "bar")
    stopWorker w
    putStrLn "Finished!"

Вот такая вот портянка была написана под влиянием дискуссии с HaskellGovno http://govnokod.ru/11968, и недавней его просьбой рассказать об общении потоков в хаскеле.

Код запускает тред, в который можно передавать различные сообщения (ограничение только одно - тип сообщения должен быть инстансом тайпкласса Typeable). В треде исполняются указанные хендлеры, каждый из которых ловит свой тип сообщений.

P.S. Для неимеющих хаскеля, но желающих посмотреть на работу кода: http://ideone.com/OMVamc.

bormand, 22 Октября 2012

Комментарии (43)

Haskell / Говнокод #11510

−79

01
02
03
04
05
06
07
08
09
10
11

t = 40000 -- количество итераций, чтобы выполнялось примерно 1 миллисекунду
                -- экспериментальным путем определено, что для ideone'вских машин это значение ~40000
 
sleep x = (apply (t*x) id x) `seq`
    ("I've waited ~" ++ show x ++ " milliseconds to tell this: 'pipisiunchik'.")

-- apply применяет ф-цию f к x n раз
apply 0 _ !x = x
apply !n !f !x = apply (n - 1) f (f x)
 
main = putStrLn $ sleep 1000

Спешу представить вам плод моего безделья: чистая ф-ция sleep на Haskell!

Тесты:
1sec - http://ideone.com/sLxRx
3.5sec - http://ideone.com/vn4Fd
10sec - http://ideone.com/U8s36

zim, 31 Июля 2012

Комментарии (16)

Haskell / Говнокод #10205

−84

01
02
03
04
05
06
07
08
09
10
11

data (,) a b = (,) a b
    deriving Generic
data (,,) a b c = (,,) a b c
    deriving Generic
data (,,,) a b c d = (,,,) a b c d
    deriving Generic
.......
data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
    -- deriving Generic
{- Manuel says: Including one more declaration gives a segmentation fault.

Вот такая вот реализация туплов:
http://www.haskell.org/ghc/docs/7.4.1/html/libraries/ghc-prim-0.2.0.0/src/GHC-Tuple.html

bormand, 05 Мая 2012

Комментарии (15)

Haskell / Говнокод #9598

−92

01
02
03
04
05
06
07
08
09
10
11

-- | The unit datatype @()@ has one non-undefined member, the nullary
-- constructor @()@.
data () = () deriving Generic

data (,) a b = (,) a b
. . .
data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
    -- deriving Generic
{- Manuel says: Including one more declaration gives a segmentation fault.
. . .

*тяжелый вздох*

http://www.haskell.org/ghc/docs/latest/html/libraries/ghc-prim-0.2.0.0/src/GHC-Tuple.html#%28%29

wvxvw, 03 Марта 2012

Комментарии (64)

Haskell / Говнокод #6765

−357

01
02
03
04
05
06
07
08
09
10
11
12
13
14

chislo :: String -> Bool
chislo []=True
chislo (x:xs) =if (x=='1') then chislo xs
               else if (x=='2') then chislo xs
                 else if (x=='3') then chislo xs
                   else if (x=='4') then chislo xs
                     else if (x=='5') then chislo xs
                       else if (x=='6') then chislo xs
                         else if (x=='7') then chislo xs
                           else if (x=='8') then chislo xs
                             else if (x=='9') then chislo xs
                               else if (x=='0') then chislo xs
                                 else if (x=='.') then chislo xs
							 else False

haskell

resettik, 26 Мая 2011

Комментарии (45)

Haskell / Говнокод #3942

−91

1
2

fac 1 = 1
fac n = fac (n-1) * n

Вычисления факторила advanced-нубами с луркмора(с) на Haskell

sergylens, 11 Августа 2010

Комментарии (17)

Говнокод: по колено в коде.