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

    −1

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 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

    Комментарии (14)
  2. Haskell / Говнокод #23859

    +6

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    data Foo a = Foo {a :: a, b :: Int}
               | Bar {b :: Int}
    
    foo :: (a -> b) -> Foo a -> Foo b
    foo f [email protected]{a = a} = x{a = f a}
    foo _ [email protected]{} = x   -- error: Couldn't match type ‘a’ with ‘b’
    foo _ [email protected]{} = x{} -- error: Empty record update

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

    cast @HaskellGovno

    CHayT, 03 Марта 2018

    Комментарии (27)
  3. Haskell / Говнокод #23446

    +4

    1. 1
    2. 2
    3. 3
    4. 4
    5. 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

    Комментарии (4)
  4. Haskell / Говнокод #17746

    −99

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 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 [email protected](f:s:st) [email protected](h:t)
    	|sortFunc s f h == GT = mboG (s:st) sn
    	|True                 = mboG(h:fs) t
    	
    mboG [email protected](f:st) [email protected](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

    Комментарии (58)
  5. Haskell / Говнокод #16405

    −79

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 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

    Комментарии (7)
  6. Haskell / Говнокод #15821

    −107

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 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 [email protected](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

    Комментарии (26)
  7. Haskell / Говнокод #14343

    −83

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 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

    Комментарии (8)
  8. Haskell / Говнокод #12738

    −95

    1. 1
    2. 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)
  9. Haskell / Говнокод #12262

    −85

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    by :: Int -> [a] -> [[a]]
    by _ [] = []
    by n xs = take n xs: by n (drop n xs)
     
    words2 :: String -> (String, String)
    words2 str = conc $ words str where
        conc (x:xs) = (x, concat xs)
     
    groupTemplates :: String -> [(String, String)]
    groupTemplates xs = map (words2) (lines xs)
     
    decodeOne :: String -> [(String, String)] -> String
    decodeOne _ [] = ""
    decodeOne str (x:xs) | str == fst x = fst x ++ " " ++ snd x ++ "\n"
    decodeOne str (_:xs) = decodeOne str xs
     
    decode :: [String] -> [(String, String)] -> String
    decode bs ts = concat $ map (\b -> decodeOne b ts) bs
     
    main = do
        bits      <- readFile "bits.txt"
        templates <- readFile "templates.txt"
     
        writeFile "out.txt" $ decode (by 4 bits) (groupTemplates templates)

    http://www.cyberforum.ru/haskell/thread723767.html

    Fai, 09 Декабря 2012

    Комментарии (36)
  10. Haskell / Говнокод #12056

    −82

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 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)