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

Всего: 86

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

−22

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

kobenate :: (MonadVoretion m)
         => Config
         -> Disjunct
         -> RuleZipper
         -> m Disjunct
kobenate cfg d₀ z = uphill d₀ z 
  where
    climb t x =
      case parent x of
        Just x' -> uphill t x'
        Nothing -> return t

    uphill t x =
      case label <$> parent x of
        Just (LinkAnd{}) -> do
          i <- downhill' cfg $ reverse $ before x
          j <- downhill' cfg $ after x
          climb (i \++/ t \++/ j) x
        _ ->
          case label x of
            MultiConnector{} -> do
              m <- downhill cfg (tree x)
              let t' = t \++/ m
              climb t' x
            _ ->
              climb t x

downhill' :: (MonadVoretion m)
          => Config
          -> [Link]
          -> m Disjunct
downhill' cfg x = foldl (\++/) ([], []) <$> mapM (downhill cfg) x

downhill :: (MonadVoretion m)
         => Config
         -> Link
         -> m Disjunct
downhill cfg l0@(Node label subforest) =
  case label of
    Optional _ ->
      ifR (_decay_optional cfg)
         {-then-} (downhill cfg $ head subforest)
         {-else-} (return ([], []))
    MultiConnector _ ->
      ifR (_decay_multi cfg)
         {-then-} (do
           a <- downhill cfg l0
           b <- downhill cfg $ head subforest
           return $ a \++/ b)
         {-else-} (return ([], []))
    LinkOr{} ->
      downhill cfg =<< pickRandom subforest
    LinkAnd{} ->
      downhill' cfg subforest
    Cost{} ->
      downhill' cfg subforest
    EmptyLink ->
      return ([], [])
    Link{_link=i} -> do
      case _linkDirection i of
        Plus  -> return ([], [Left i])
        Minus -> return ([Left i], [])

Метод вореции дерева методом вниз, вверх и опять вниз, но сбоку. В индексе храним смещение бата правил, зожатых в отдельный файл. Ворециируем любое подходящее правило из индекса и розжимаем дерево в зиппер. Находим пачку подходящих зипперов, см. http://govnokod.ru/20195, ворециируем любой из них. Вверх идём просто, ничего не ворецируя, ибо нужную кобенацию важно сохранить, а вот сбоку идём вниз, тут уж можно любую кобенацию брать.

CHayT, 28 Июня 2016

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

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

−24

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

findConnections :: LinkID
                -> Link
                -> [RuleZipper]
findConnections x = go . fromTree
  where go z =
          case label z of
            Link {_link=l}
              | x' =*= l -> [z]
              | True     -> []
            _ ->
              go' (firstChild z) ++ go' (next z)

        go' x = (toList x) >>= go

        x' = flipLink x

1) создаём кучу почти полных копий дерева (не совсем полных, т.к. есть какой-никакой tail sharing)
2) но это фиксится тем, что обход дерева заканчивается преждевременно из-за ошибки!
изящный код, который можно породить только в 3 ночи под Sabaton

CHayT, 14 Июня 2016

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

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

−61

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21

-- | @'resetT' m@ delimits the continuation of any 'shiftT' inside @m@.
--
-- * @'resetT' ('lift' m) = 'lift' m@
--
resetT :: (Monad m) => ContT r m r -> ContT r' m r
resetT = lift . evalContT
{-# INLINE resetT #-}

-- | @'shiftT' f@ captures the continuation up to the nearest enclosing
-- 'resetT' and passes it to @f@:
--
-- * @'resetT' ('shiftT' f >>= k) = 'resetT' (f ('evalContT' . k))@
--
shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a
shiftT f = ContT (evalContT . f)
{-# INLINE shiftT #-}

.... Usage:

Prelude Control.Monad.Trans.Cont> evalCont $ callCC (\done -> reset (done "Ok") >> return "Fuck you!" )
"Fuck you!"

говно прямо в transformers
плохо зделали, тупо
хочу, чтобы возвращалось Ok

CHayT, 07 Июня 2016

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

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

−51

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

data TTree k v =
  TNode {
    _key :: !k
  , _val :: !(Maybe v)
  , _eq :: !(TTree k v)
  , _left :: !(TTree k v)
  , _right :: !(TTree k v)
  , _height :: !Int
  }
  | TTNil
  deriving (Show, Generic)
instance (Binary k, Binary v) => Binary (TTree k v)

insertWith' :: (Ord k)
            => (v -> v -> v) -- ^ Conflict resolution function
            -> [k]           -- ^ Key
            -> Int           -- ^ Length of the key
            -> v             -- ^ Value
            -> TTree k v     -- ^ Tree
            -> TTree k v
insertWith' f k1@(k:kt) h v t =
  case t of
    TTNil ->
      insertWith' f k1 h v $ TNode {
          _key = k
        , _eq = TTNil
        , _left = TTNil
        , _right = TTNil
        , _val = Nothing
        , _height = h
        }
    node@TNode{_key=k0, _height=h0, _val=v0, _eq=eq0, _left=left0, _right=right0} ->
      case compare k0 k of
        EQ | null kt ->
               node {
                 _val = Just $ maybe v (flip f $ v) v0
               }
           | True ->
               node {
                 _eq = insertWith' f kt (h-1) v eq0
               , _height = max h h0
               }
        GT ->
           node {
             _left = insertWith' f k1 h v left0
           , _height = max h h0
           }
        LT ->
           node {
             _right = insertWith' f k1 h v right0
           , _height = max h h0
           }
{-# SPECIALIZE insertWith' :: (v -> v -> v) 
                           -> [Char] 
                           -> Int
                           -> v 
                           -> TTree Char v
                           -> TTree Char v
  #-}

а почему бы не использовать несбалансированное тернанрое дерево для индекса
вроде ничего стра
Out of memory: Kill process 2987 (govno) score 265 or sacrifice child

CHayT, 25 Мая 2016

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

Си / Говнокод #20049

−39

1
2
3
4
5
6
7
8
9

<?php include_once "stdio.h"; ?>

int main()
{
    <?php
        for($i = 0; $i < 20; $i++)
            echo 'printf("%d\n", '.$i.');';
    ?>
}

You can use PHP as a C preprocessor. The advantages are:

very similiar syntax, so syntax highlighting works.
<? and ?> are not used in standard C (with non-standard C, the only thing that gets broken is old GCC extension operator that returns min/max)
it's rich in libraries.
it's turing complete.
usage of macros is very explicit. (compared to sneaky C preprocessor macros)

For serious use though, making PHP print the #line directives is needed for debugging preprocessed code.

http://stackoverflow.com/questions/396644/replacements-for-the-c-preprocessor/16256052#16256052
ящитаю это гениально

CHayT, 20 Мая 2016

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

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

−60

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

instance Applicative (Sample m) where
  pure a = Val a

  Val{_unVal=f} <*> a = fmap f a
  Fork{..} <*> a = Fork {
      _next = \x -> (_next x) <*> a
    , ..
    }
  Zero <*> _ = Zero
  Random{..} <*> a = Random { -- Crazy-ass weirdo haskeller, why did you define instance Random for ->?!!
      _next = \x -> (_next x) <*> a
    , ..
    }

CHayT, 07 Мая 2016

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

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

−56

1

import Control.Lens

то неловкое чувство, когда долго боролся с искушением, и таки добавил эту строчку
https://ro-che.info/ccc/23

CHayT, 02 Мая 2016

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

Куча / Говнокод #19694

+5

1

https://meduza.io/shapito/2016/03/24/iskusstvennyy-intellekt-ot-microsoft-za-sutki-polyubil-gitlera-i-voznenavidel-feministok

RIP in peace, nazi AI ;_;

CHayT, 25 Марта 2016

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

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

−54

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

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

−57

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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)

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