1. Список говнокодов пользователя CHayT

    Всего: 88

  2. Haskell / Говнокод #19679

    −54

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    refactorMe ∷ (Monad m) ⇒ (a → b) → Producer a m r → Producer b m r
refactorMe f p = do
  n ← lift $ next p
  case n of
    Left r → return r
    Right (x, p') → do
      yield $ f x
      refactorMe f p'

    ниасилил pipes

    CHayT, 22 Марта 2016

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

  3. Haskell / Говнокод #19672

    −57

    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
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    96. 96
    97. 97
    98. 98
    module Control.Monad.Warning (
   errorToWarning
 , errorsToWarnings
 , justW
 , rightW
 , WarningT(..)
 , MonadWarning(..)
 , module Control.Monad.Except
 , module Control.Monad.Writer
 )
 where

import Control.Applicative
import Control.Monad.Except
import Control.Monad.Writer
import Control.Monad.Reader
import Data.Monoid

newtype WarningT w e m a = WarningT { runWarningT ∷ w → m (w, Either e a) }

class (Monad m) ⇒ MonadWarning w e m | m → w e where
  warning ∷ w → m ()
  throwW  ∷ e → m a
  catchW  ∷ m a → (e → m a) → m a

instance (Functor m) ⇒ Functor (WarningT w e m) where
  fmap f a = WarningT $ \w → let f' (w', a') = (w', (fmap f) a')
                             in fmap f' $ runWarningT a w

instance (Applicative m) ⇒ Applicative (WarningT w e m) where
  pure a = WarningT $ \w → pure (w, Right a)
  f <*> a = WarningT $ \w → runWarningT f w 
       (w', f') = 
       (w'', a') = runWarningT a w'
     in case (f', a') of
       (Right f'', Right a'') → undefined --runWarningT (f'' a'') w''
       (Left l, _) → pure (w', Left l)
       (_, Left l) → pure (w'', Left l)

instance (Monad m, Monoid w) ⇒ Monad (WarningT w e m) where
  return a = WarningT $ \w → return (w, Right a)
  
  a >>= b = WarningT $ \w → do
    (w', e) ← runWarningT a w
    case e of
     Right r → runWarningT (b r) w'
     Left l → return (w', Left l)

  fail = WarningT . fail

instance (Monad m, Monoid w) ⇒ MonadWarning w e (WarningT w e m) where
  warning w' = WarningT $ \w → return (w `mappend` w', Right ())

  throwW e = WarningT $ \w → return (w, Left e)
  
  catchW a f = WarningT $ \w → do
    (w', e) ← runWarningT a w
    case e of
     Right e' → return (w', Right e')
     Left e' → runWarningT (f e') w'

instance (MonadWarning w e m) ⇒ MonadError e m where
  throwError = throwW
  catchError = catchW

instance (Monoid w, MonadWarning w e m) ⇒ MonadWriter w m where
  tell = warning

instance MonadTrans (WarningT w e) where
  lift a = WarningT $ \w → do
    a' ← a
    return $ (w, Right a')

instance (Monoid w, MonadIO m) ⇒ MonadIO (WarningT w e m) where
  liftIO = lift . liftIO

instance (MonadReader r m, Monoid w) ⇒ MonadReader r (WarningT w e m) where
  ask = lift ask
  -- TODO: Check and test it.
  local f a = WarningT $ \w → local f $ runWarningT a w
  
errorToWarning ∷ (Monoid w, MonadWarning w e m) ⇒ (e → w) → (e → m a) → m a → m a
errorToWarning f g a = catchW a (\e → warning (f e) >> g e)

errorsToWarnings ∷ (Monoid w, MonadWarning w e m) ⇒ (e → w) → [m a] → m [a]
errorsToWarnings f = foldl go (return [])
  where go r a = errorToWarning f (const r) $ do
          a' ← a
          r' ← r
          return $ a' : r'--
          
justW ∷ (MonadWarning w e m) ⇒ e → Maybe a → m a
justW _ (Just x) = return x
justW e Nothing  = throwW e

rightW ∷ (MonadWarning w e m) ⇒ (e' → e) → Either e' a → m a
rightW _ (Right x) = return x
rightW f (Left e) = throwW (f e)

    выкладываю перед выпиливанием этого говна

    CHayT, 22 Марта 2016

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

  4. Куча / Говнокод #19653

    +4

    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
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    {- This code intentionally was made slightly cryptic -}
{-# LANGUAGE GADTs, StandaloneDeriving, UnicodeSyntax, KindSignatures, FlexibleInstances, LambdaCase, CPP, BangPatterns #-}
import System.Exit
import Data.Functor
import Control.Monad.IO.Class
import Control.Monad.Trans.Cont
import System.Random
import System.Posix.Signals
import System.Environment
import Control.Concurrent.MVar

instance Eq (Int → Int) where
  _ == _ = True -- It's a hack

infixl 7 :.

data T ∷ * where {J, Â, Â', S, K ∷ T; (:.) ∷ T → T → T; Ψ ∷ {σ ∷ String} → T
                 ;F ∷ (Int → Int) → T; N ∷ Int → T; Ø ∷ String → T}

parse ∷ String → [T] → T
parse ('f':'u':c) t = parse c (J:t)
parse ('b':'a':'r':c) t = parse c (Â:t)
parse ('~':c) (a:b:t) = parse c (b:.a:t)
parse ('~':_) _ = error "Parse error: missing operand(s)"
parse (_:c) t = parse c t
parse [] (h:_) = h :. Ψ []
parse [] [] = error "Parse error: empty program"

s ∷ T → T
s (J :. x) = (x :. S) :. K
s (K :. x :. _) = x
s (S :. x :. y :. z) = (x :. z) :. (y :. z)
s (F f :. N i) = N $ f i
s (F f :. F g) = F $ f . g
s (Â' :. N i :. ψ @ (Ψ {})) = ψ {σ = toEnum i : σ ψ}
s (Â :. n :. ψ @ (Ψ {})) = Â' :. (n :. F (+1) :. N 0) :. ψ
-- Other cases
s (a :. b) = (s a) :. (s b)
s x = x

eval ∷ (T → t) → (T → t) → T → t
eval fp done t | t == t'   = done t
               | otherwise = fp t'
    where t' = s t

ψs a@Ψ{σ=s} = [(a, s)]
ψs (a:.b) = ψs a ++ ψs b
ψs _ = []

r' ∷ T → [(T, String)]   -- Very inefficient; should be rewritten
r' a | null t = [(a, s)] where ((_, s):t) = ψs a
r' (a :. b) = r' a ++ r' b
r' _ = []

r ∷ T → IO (Maybe T)
r t = case r' t of
        [] → return Nothing
        t' → ((t' !!) <$> randomRIO (0, length t' - 1)) >>= \case
           (Ψ{}, s) → putStrLn (reverse s) >> return Nothing
           (t'', s) → putStrLn (reverse s) >> return (Just t'')

setMVar v = (tryTakeMVar v >>) . putMVar v

loop v f n = callCC $ \done → loop1 done (\fp → f fp done) n
  where loop2 interrupt f' n = do
          n' ← liftIO (readMVar v) >>= \case
            0 → f' interrupt n
            _ → callCC $ \fp → f' fp n
          liftIO $ modifyMVar_ v $ (\k → return $ k-1)
          loop2 interrupt f' n'
        loop1 done f' n = do
          n' ← callCC $ \int → loop2 int f' n
          liftIO $ putStrLn "Measure (m) Abort (a) Continue (c) Run steps (number)"
          (liftIO getLine) >>= \case
            "a" → f' done n' >> return ()
            "c" → liftIO $ setMVar v (-1)
            "m" → liftIO (r n') >>= \case
              Nothing → liftIO exitSuccess
              Just n'' → loop1 done f' n'' >> return ()
            a → case readsPrec 0 a of
                   (n,_):_ → liftIO $ setMVar v n
                   _ → liftIO $ putStrLn "Not understood."
          loop1 done f' n'

main ∷ IO ()
main = do
  (file, n) ← getArgs >>= \case
    [f] → return (f, -1)
    ["-s", n, f] → case readsPrec 0 n of
                    (n',_):_ → return (f, n')
                    _ → error "Argument of -s should be a number"
    _ → error "Insufficient arguments. Expected [-s NUMBER_OF_STEPS] FILE"
  cnt ← newMVar n
  installHandler keyboardSignal (Catch $ setMVar cnt 0) Nothing
  void $ (r =<<) (evalContT $ loop cnt eval =<< (parse <$> readFile file))

    больше трясин богу тьюринг-полноты
    1) литературное программирование
    2) зайчатки REPL
    3) чисто функциональное IO без манад и uniq-types
    4) "квантовые" вычисления
    5) только два комбинатора

    CHayT, 18 Марта 2016

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

  5. Куча / Говнокод #19570

    +4

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    #!/bin/bash
echo "(find-file \"$1\")" >> ~/.emacs.d/cmdfile

В emacs периодически дергается

(defun read-cmd-file ()
  (load-file "~/.emacs.d/cmdfile")
  (delete-file "~/.emacs.d/cmdfile"))

(run-with-idle-timer 1 t 'read-cmd-file)

    гуру emacs ЛОРа

    CHayT, 03 Марта 2016

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

  6. Swift / Говнокод #19104

    −33

    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
    //
//  How ARC causes memory leaks and leads to crashes out of the blue
//

import Foundation

let noLeak = 131030          // Empirically found constant
let withLeak  = noLeak*10

// Single-linked list
class R {
    var _a : R?
    init(a : R?) {
        _a = a
    }

//    One have to resort to a manual C-like code to fix it
//
//    deinit {
//        var i = self._a;
//        while let i2 = i {
//            let t = i2._a
//            i2._a = nil
//            i = t
//        }
//    }
}

func test(n:Int, leak:Bool) {
    let p0 = R(a : nil)
    var p = R(a : p0)
    for _ in 1...n {
        p = R(a : p)
    }
    if leak {
        // When the list is not cyclic it will be deleted by ARC just fine...
        p0._a = p
    }
} // Oh wait, the destructor isn't tail-recursive...

test(withLeak, leak: true)
print("Bad leaking function")
test(noLeak, leak: false)
print("Good function")

    гц -- сила, ARC -- могила
    (язык -- Swift, если что)

    CHayT, 28 Ноября 2015

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

  7. Куча / Говнокод #19004

    +2

    1. 1
    2. 2
    -- Hehehe
typeGroups ll = (\(t, tt) -> printf "\n~~~~~~~~~~~~~~~\n%s\n~~~~~~~~~~~~~~~\n%s" t (show tt))  >>= (nub . map (_measInfoId &&&(snd .unzip . M.toList . _measTypes)) . (>>= _measInfo) . (>>= _measData)) $ (concat `fmap` mapM (\file -> runX $ readXml file >>> parseFile)) ll

    скрипт, высранный в спешке для обработки данных в одной задаче перерос в утилиту

    CHayT, 10 Ноября 2015

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

  8. Куча / Говнокод #18907

    +2

    1. 1
    2. 2
    getKeyFingerprint(Key) ->
  os:cmd("ssh-keygen -lf /dev/stdin <<< '~p'", [Key]).

    CHayT, 24 Октября 2015

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

  9. bash / Говнокод #18840

    −47

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    #!/bin/bash
cmd='SHELL="/bin/tcsh -e ~/bin/start_emulator";'
sshcmd="/bin/bash -c '$cmd /proj/bin/set_proj_clearcase_view $view'"
host=`~/bin/find_free_host`
ssh $host -t $sshcmd

    хотите страшную историю на ночь?
    ClearCase

    CHayT, 08 Октября 2015

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

  10. Куча / Говнокод #18822

    +2

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    %%% O(n log n)
nub([]) -> [];
nub([H|T]) ->                    
    case lists:member(H, T) of
        true ->
            nub(T);
        false ->
            [H|nub(T)]
    end.

    кто-то услышал про логлинейный nub, и решил, что у него тоже получится

    CHayT, 06 Октября 2015

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

  11. C++ / Говнокод #18748

    +2

    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
    57. 57
    58. 58
    59. 59
    60. 60
    #include <memory>
#include <list>

struct ListNode;
using List = std::unique_ptr<const ListNode>;

struct ListNode {
    const int data;
    const List next;
    
    ~ListNode()
    {
        if(!next)
	    return;
	else {
	    std::list<ListNode*> nodes;
	    for(auto pn = next.get(); pn->next; pn = pn->next.get()) {
		nodes.push_back(const_cast<ListNode*>(pn));
	    }
	    for(decltype(nodes)::reverse_iterator in = nodes.rbegin(); in != nodes.rend(); ++in) {
		const_cast<List&>((*in)->next).reset();
	    }
	}
    }
};

List Cons(int head, List tail)
{
    return List(new ListNode{head, std::move(tail)});
}

List Nil()
{
    return List();
}

size_t len(const List & self)
{
    if (!self) {
        return 0;
    }
    return 1 + len(self->next);
}

#include <iostream>

void test(size_t n)
{
    auto p = Nil();
    for (size_t i = 0; i < n; ++i) {
        auto x = std::move(p);
        p = Cons(1, std::move(x));
    }
    std::cout << "done: " << std::endl;
}

int main()
{
    test(131028);
}

    односвязный список против джависта
    источник: https://www.linux.org.ru/forum/development/11752940?cid=11755489

    CHayT, 22 Сентября 2015

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