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

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

0

1
2
3
4
5
6
7

doit({txs, [Tx]}) ->
    X = tx_pool_feeder:absorb(Tx),
    Y = case X of
	    ok -> hash:doit(testnet_sign:data(Tx));
	    _ -> <<"error">>
		     end,
    {ok, Y};

Прекраснейший код на Erlang из великолепнейшей криптовалюты AMOVEO
Здесь мы видим эндпоинт для отправки транзакций в сеть, возвращающий в случае ошибки ["ok","ZXJyb3I="]
Приглядевшись можно увидеть закодированное в base64 слово «error»

silvesterdrago, 24 Января 2019

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

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

−2

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

instance Arbitrary ProjectConfig where
    arbitrary =
      ProjectConfig
        <$> (map getPackageLocationString <$> arbitrary)
        <*> (map getPackageLocationString <$> arbitrary)
        <*> shortListOf 3 arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> arbitrary
        <*> (MapMappend . fmap getNonMEmpty . Map.fromList
               <$> shortListOf 3 arbitrary)
        -- package entries with no content are equivalent to
        -- the entry not existing at all, so exclude empty

    shrink ProjectConfig { projectPackages = x0
                         , projectPackagesOptional = x1
                         , projectPackagesRepo = x2
                         , projectPackagesNamed = x3
                         , projectConfigBuildOnly = x4
                         , projectConfigShared = x5
                         , projectConfigProvenance = x6
                         , projectConfigLocalPackages = x7
                         , projectConfigSpecificPackage = x8
                         , projectConfigAllPackages = x9 } =
      [ ProjectConfig { projectPackages = x0'
                      , projectPackagesOptional = x1'
                      , projectPackagesRepo = x2'
                      , projectPackagesNamed = x3'
                      , projectConfigBuildOnly = x4'
                      , projectConfigShared = x5'
                      , projectConfigProvenance = x6'
                      , projectConfigLocalPackages = x7'
                      , projectConfigSpecificPackage = (MapMappend
                                                         (fmap getNonMEmpty x8'))
                      , projectConfigAllPackages = x9' }
      | ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8', x9'))
          <- shrink ((x0, x1, x2, x3),
                      (x4, x5, x6, x7, fmap NonMEmpty (getMapMappend x8), x9))
      ]

В хачкеле мало бойлерплейта, говорили они. Это ещё далеко не самый длинный список, см. x43 ниже.

https://github.com/haskell/cabal/blob/4e0c701a2feb520d369ef506a18288c47f64b06a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs

roman-kashitsyn, 06 Июля 2018

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

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

+6

1
2
3
4
5
6
7

data Foo a = Foo {a :: a, b :: Int}
           | Bar {b :: Int}

foo :: (a -> b) -> Foo a -> Foo b
foo f x@Foo{a = a} = x{a = f a}
foo _ x@Bar{} = x   -- error: Couldn't match type ‘a’ with ‘b’
foo _ x@Bar{} = x{} -- error: Empty record update

Рекорды всё-таки дубовые

cast @HaskellGovno

CHayT, 03 Марта 2018

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

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

+4

1
2
3
4
5

-- https://haskell-lang.org/library/http-client
let request = setRequestBodyFile "people.yaml"
            $ setRequestHeader "Content-Type" ["application/x-yaml"]
            $ "PUT https://httpbin.org/put"
response <- httpJSON request

Товарищ Снойман, конечно, молодец, но его творчество мне зачастую больше напоминает жабу, чем хачкель. У меня одного такое ощущение?

(Неявное) преобразование "PUT https://httpbin.org/put" в значение Request — это, кмк, какой-то ⊥(bottom)

#нытьё #CHayT

roman-kashitsyn, 23 Октября 2017

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

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

−99

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

--Поиск минимальной выпуклой оболочки
import Data.List; import Data.Ord
--общие функции и типы
data Point = P{x::Float,y::Float}
	deriving (Show,Eq) 
	
getRotate a b c = baX * cbY - baY * cbX
	where baX = x b - x a; baY = y b - y a;
		  cbX = x c - x b; cbY = y c - y b;
		 
sortFunc a b c 
	|k < 0  = LT
	|k == 0 = compare (long a c) (long a b) 
	|k > 0  = GT
		where k = getRotate a b c

long a b = (x b - x a)*(x b - x a) + (y b - y a)*(y b - y a)
		
getLeftPoint = minimumBy (comparing x)
--Джарвис
getMBOJarvis l = mboJ fp l fp
	where fp = getLeftPoint l		
		
mboJ current list fp 
	|getRotate current next fp > 0   = []
	|True                            = current : mboJ next listWOC fp
		where listWOC = filter ((/=)current) list;
			  next    = minimumBy (sortFunc current) listWOC;
--Грехем			
getMBOGragam = tail.throwGraham.sortGraham 

sortGraham list = fp:sortBy (sortFunc fp) list
	where  fp = getLeftPoint list
		   
throwGraham (f:s:t) = mboG (s:f:[]) t
		   
mboG fs@(f:s:st) sn@(h:t)
	|sortFunc s f h == GT = mboG (s:st) sn
	|True                 = mboG(h:fs) t
	
mboG fs@(f:st) sn@(h:t)   = mboG(h:fs) t
	
mboG l [] = l
--тесты		     
testList1 = [P 0 (-1), P (-1) 0, P 0 1,P 1 0,P (-0.5) (-0.5),P 0.5 (-0.5),P (-0.5) 0.5,P 0.5 0.5,P 0 0]
		  
testList2 = [P 0 0, P 1 0, P 0 1,P 2 0,P 1 1,P 0 2,P 2 1,P 1 2,P 2 2]
	
	
testJ1  = mapM_ print $ getMBOJarvis testList1		
		
testG1  = mapM_ print $ getMBOGragam testList1

testJ2  = mapM_ print $ getMBOJarvis testList2		
		
testG2  = mapM_ print $ getMBOGragam testList2

Haskell
[сарказм]
Как я могу идти против моды - не заливать этих французских лаб и не выпивать чаю?

Выкладываю, что бы порадовать своего кота Барсика. Барсик, покойся с миром.

А спонсор этого говна - компания "Потролль препода". "Потролль препода" - пиши лабы на хаскелле
[/сарказм]

kegdan, 07 Марта 2015

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

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

−79

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

map_of_enemy :: [[Int]] -> [[Int]]
map_of_enemy [] = []
map_of_enemy list = (iniciar (0) (0) (list))

iniciar :: Int -> Int -> [[Int]] -> [[Int]]
iniciar a b list = if(a == (length list)-1) then [rango a 0 list]
               else [rango a 0 list]++[(iniciar (a+1) 0 list)]

rango :: Int -> Int -> [[Int]] -> [Int]
rango a b list = if (b==(length list)-1 && (((list!!a!!0)==(list!!b!!0)) &&     ((list!!a!!1)==(list!!b!!1)) && ((list!!a!!2)==(list!!b!!2))))
             then [0]
             else if (b==(length list)-1 && (((list!!a!!0)/=(list!!b!!0)) || ((list!!a!!1)/=(list!!b!!1)) || ((list!!a!!2)/=(list!!b!!2))))
             then (rango2 a (list!!b) list)
             else if (((list!!a!!0)==(list!!b!!0)) && ((list!!a!!1)==(list!!b!!1)) && ((list!!a!!2)==(list!!b!!2)))
             then [0]++(rango a (b+1) list)
             else (rango2 a (list!!b) list)++(rango a (b+1) list)

rango2 :: Int -> [Int] -> [[Int]] -> [Int]
rango2 a b list = if ((verif [(list!!a!!0)+(list!!a!!2),(list!!a!!1)+(list!!a!!2)] [(list!!a!!0)-(list!!a!!2),(list!!a!!1)-(list!!a!!2)] (b))) then [1]
              else [0]

verif a b c = if (((c!!0) < (a!!0)) && ((c!!0) > (b!!0)) && ((c!!1) < (a!!1)) && ((c!!1) > (b!!1))) then True
          else if (((c!!0) < (a!!0)) && ((c!!0) == (b!!0)) && ((c!!1) < (a!!1)) && ((c!!1) == (b!!1))) then True
          else if (((c!!0) == (a!!0)) && ((c!!0) > (b!!0)) && ((c!!1) == (a!!1)) && ((c!!1) > (b!!1))) then True
          else False

Haskell
OMG mode on

kegdan, 22 Июля 2014

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

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

−107

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

import System.Exit
import Graphics.UI.GLUT
import Control.Monad
import Control.Applicative
import Control.Arrow
import Control.Concurrent
import Graphics.Rendering.OpenGL 
import Data.IORef
import Data.List
import Data.Maybe
initial = ((0,0),(0.005,-0.03),(0,0),([(-0.4,-0.9),(-0.4,-0.85),(0.4,-0.85),(0.4,-0.9),(-0.4,-0.9)],(0,0)),liftM2 (,) [-0.9,-0.7..0.9] [0.5,0.7,0.9])
ws = dzip [(-1,-1),(-1,1),(1,1),(1,-1)] ; r = 0.1 :: GLfloat
main = initialWindowSize $= Size 777 777 >> initialWindowPosition $= Position 100 100 >> initialDisplayMode $= [DoubleBuffered] >> createWindow "ursula" >> 
	newIORef initial >>= \ior -> keyboardMouseCallback $= Just (kbd ior) >> displayCallback $= dlay ior >> idleCallback $= Just (anime ior) >> mainLoop
dlay ior = clearColor $= Color4 1 1 1 1 >> clear [ColorBuffer] >> readIORef ior >>= drawDoxyq >> swapBuffers
kbd _ (Char 'q') Down _ _ = exitWith ExitSuccess			
kbd s (Char x) Down _ _   = modifyIORef' s $ \(a,b,t,(d,e),cs) -> (a,b,t,(d,(if x == '[' then -0.05 else if x == ']' then 0.05 else fst e,0)),cs)
kbd _ _ _ _ _ = return ()
draw c = renderPrimitive c . mapM_ (vertex . uncurry Vertex2)
touch xy s xy' = guard ((xy ==== xy') <= r+r && (s .*. (xy.-.xy')) <= 0) >> Just (xy.-.xy')
drawDoxyq ((x,y),_,(t,_),(bd,_),cs) = currentColor $= Color4 0.3 0.4 0.8 0 >> mapM_ (mapM_ (draw LineLoop) . sta) cs >> 
	currentColor $= Color4 0.7 0.1 0.2 1 >> mapM_ (draw LineStrip) swa >> currentColor $= Color4 0 0 0 1 >> draw Polygon bd  where
	swa = [[(x,y),(x + r/1.8*cos (th+pi/4),y + r/1.8*sin (th+pi/4)),(x + r/1.2*cos th,y + r/1.2*sin th)] | th <- [t,t+pi/2..t+1.6*pi]]
	sta (x,y) = [[(x,y+r/2),(x-r/2,y-r/2),(x+r/2,y-r/2)],[(x+r/2,y+r/2-0.03),(x-r/2,y+r/2-0.03),(x,y-r/2-0.03)]]
frame (xy,v,(tt,tr),(b,s),cs) = if snd xy <= r-0.99 || null cs then error "GAME OVER" else (xy.+.v',v',(tt+tr',tr'),(b',s'),cs') where 
	v' = listy v (\us -> rV (2*negv v .>. foldl1' (.+.) us + tr/11) $ negv v) $ mapMaybe (cutSect xy v) (ws ++ dzip b') ++ mapMaybe (touch xy v) cs
	s' = 0.93 *. if any ((1<=) . (*signum (fst s)) . fst) b then negv s else s
	b' = map (.+.s') b ; cs' = filter (isNothing . touch xy v) cs
	tr' = if v .=. v' then tr else (v' .>. v)/19
listy d f x = if null x then d else f x
rV t (x,y) = (x*cos t - y*sin t,y*cos t + x*sin t)
anime ior = modifyIORef' ior frame >> threadDelay 30000 >> postRedisplay Nothing
cutSect xy s c@(u,v) = guard (xy ./ l <= r && w `oncut` c && (s .*. (xy.-.w)) <= 0) >> Just (xy.-.w) where 
	l = ln u (u.-.v) ; w = xy .-| l
oncut u (v,w) = 0 <= (u.-.v) .*. (w.-.u) && 0 <= (u.-.w) .*. (u.-.w) && ((u.-.w) .<>. (v.-.w)) # 0
ln xy w = (snd w,-fst w,w.<>.xy)
(x,y) .-| (a,b,c) = ((b^2*x - a*c - a*b*y)/(a^2 + b^2),-(b*c + a*b*x - a^2*y)/(a^2 + b^2))
p ./ ln = p ==== p .-| ln ; pop f (a,b) (c,d) = (f a c,f b d)		
(.+.) = pop (+) ; (.-.) = pop (-)  ; (.=.) = (uncurry (&&) .) . pop (#) 
(*.) = tmap . (*) ; (.*.) = (uncurry (+) .) . pop (*)
(.<>.) = (uncurry (-) .) . (. uncurry (flip (,))) . pop (*) ; v .>. u = atan2 (v .<>. u) (v .*. u) 
norm = sqrt . join (.*.) ; a ==== b = norm $ a.-.b ; negv = tmap negate
infix 4 #,*. ; infix 3 .+.,==== ; infix 8 .>.
x # y = abs (x-y) < 0.00001 ; tmap = join (***)
dzipWith = (<*> drop 1) . zipWith ; dzip = dzipWith (,)

Вся суть выразительности Haskell

jkhne4pijgberg, 22 Апреля 2014

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

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

−83

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

setRegState :: RegisterStates -> M_Register -> Word8 -> RegisterStates
setRegState rs r n =
  let (a, b, c, d, e, f, h, l, pc, sp) = rs in
  case r of
    M_A -> (n, b, c, d, e, f, h, l, pc, sp)
    M_B -> (a, n, c, d, e, f, h, l, pc, sp)
    M_C -> (a, b, n, d, e, f, h, l, pc, sp)
    M_D -> (a, b, c, n, e, f, h, l, pc, sp)
    M_E -> (a, b, c, d, n, f, h, l, pc, sp)
    M_F -> (a, b, c, d, e, n.&.0xF0, h, l, pc, sp)
    M_H -> (a, b, c, d, e, f, n, l, pc, sp)
    M_L -> (a, b, c, d, e, f, h, n, pc, sp)

Haskell has no boilerplate.
Из исходников заброшенного эмулятора GameBoy (https://github.com/bitc/omegagb/)

Yuuri, 10 Января 2014

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

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

−95

1
2

instance Show (a -> b)
main = print (*)

http://liveworkspace.org/code/17QAgf$23
stderr:
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
Возможно это из-за того, что нет реализации show и я написать вменяемую не смогу. Как заставить Haskell сгенерировать для меня show?

Хочется типа такого:

{-# LANGUAGE OverlappingInstances, FlexibleInstances, UndecidableInstances, StandaloneDeriving, DeriveFunctor #-}

deriving instance Show (a -> b)

main = print (*)

http://liveworkspace.org/code/17QAgf$21
http://www.haskell.org/ghc/docs/6.12.1/html/users_guide/deriving.html
http://www.haskell.org/haskellwiki/GHC/Stand-alone_deriving_declarations

HaskellGovno, 13 Марта 2013

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

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

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