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

    0

    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
    (ql:quickload :drakma)
(ql:quickload :lparallel)

;; CURL ANALYSIS

(defmethod sb-mop:validate-superclass ((metaclass class) (superclass standard-class)) t)

;; Analasys-Assert class
(defclass anal-ass (standard-class)
  ((%form :initarg :form :initform nil :accessor form)
   (%cond :initarg :cond :initform nil :accessor econd)
   (%mesg :initarg :msg :initform "Error" :accessor msg)))

(defmacro build-anal-ass (&body args)
  `(make-instance 'anal-ass ,@args))

(defmethod process-ass-synergy ((anal-ass-factory anal-ass))
  (let ((anal-ass-factory-cond-master (econd anal-ass-factory))
        (anal-ass-factory-form-master (form anal-ass-factory))
        (anal-ass-factory-msg-master (msg anal-ass-factory)))

    (declare (ignore anal-ass-factory-form-master))

    (assert anal-ass-factory-cond-master nil anal-ass-factory-msg-master)))

;; Analasys class
(defclass anal-factory (standard-class)
  ((%body-manager :initarg :body :initform nil :accessor body-manager)
   (%status-manager :initarg :status :initform nil :accessor status-manager)
   (%headers-manager :initarg :headers :initform nil :accessor headers-manager)
   (%uri-manager :initarg :uri :initform nil :accessor uri-manager)
   (%stream-manager :initarg :stream :initform nil :accessor stream-manager)
   (%must-close-manager :initarg :must-close :initform nil :accessor must-close-manager)
   (%reason-phrase-manager :initarg :reason-phrase :initform nil :accessor reason-phrase-manager)))

(defmethod initialize-instance :after ((anal-ass-factory anal-ass) &key &allow-other-keys)
  (assert (and (form anal-ass-factory) (econd anal-ass-factory) (msg anal-ass-factory)) nil
    "Invalid Analysis-Assert structure"))

(defmethod initialize-instance :after ((anal-factory-factory anal-factory) &key &allow-other-keys)
  (let ((anal-body-ass-manager (build-anal-ass :msg "Body manager is nil" :form t :cond #'(lambda () (body-manager anal-factory-factory))))
        (anal-status-ass-manager (build-anal-ass :msg "Status manager is nil" :form t :cond #'(lambda () (status-manager anal-factory-factory))))
        (anal-headers-ass-manager (build-anal-ass :msg "Headers manager is nil" :form t :cond #'(lambda () (headers-manager anal-factory-factory))))
        (anal-uri-ass-manager (build-anal-ass :msg "URI manager is nil" :form t :cond #'(lambda () (uri-manager anal-factory-factory))))
        (anal-stream-ass-manager (build-anal-ass :msg "Stream manager is nil" :form t :cond #'(lambda () (stream-manager anal-factory-factory))))
        (anal-must-close-ass-manager (build-anal-ass :msg "Must-close manager is nil" :form t :cond #'(lambda () (must-close-manager anal-factory-factory))))
        (anal-reason-phrase-ass-manager (build-anal-ass :msg "Reason phrase manager is nil" :form t :cond #'(lambda () (reason-phrase-manager anal-factory-factory)))))

    (process-ass-synergy anal-body-ass-manager)
    (process-ass-synergy anal-status-ass-manager)
    (process-ass-synergy anal-headers-ass-manager)
    (process-ass-synergy anal-uri-ass-manager)
    (process-ass-synergy anal-stream-ass-manager)
    (process-ass-synergy anal-must-close-ass-manager)
    (process-ass-synergy anal-reason-phrase-ass-manager)))

(defmacro deep-anal-factory (&body args)
  `(make-instance 'anal-factory ,@args))

(defclass drakma-manager (standard-class)
  ((%body-meta-manager :initform nil :initarg :body :accessor body)))

(defmethod requires-meta-manager ((drakma-manager-factory drakma-manager))
  (funcall (body drakma-manager-factory)))

(defmacro make-drakma-meta-manager (&body args)
  `(make-instance 'drakma-manager ,@args))

(defun anal-manager (url &key (method :get) parameters)
  (locally
    (declare (optimize (speed 0) (debug 0) (safety 0) (space 0)))

    (multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
      (let* ((eval #'(lambda () (drakma:http-request url :method method
                                                         :parameters parameters
                                                         :want-stream nil)))

             (drakma-meta-manager (make-drakma-meta-manager :body eval)))

        (requires-meta-manager drakma-meta-manager))

      (declare (optimize (speed 3)))

      (let ((deep-anal (deep-anal-factory
                          :body body
                          :status status-code
                          :headers headers
                          :uri uri
                          :stream stream
                          :must-close must-close
                          :reason-phrase reason-phrase)))

        (identity deep-anal)))))

    Менеджер для анализа юрл

    Запостил: lisp-worst-code, 12 Ноября 2025

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

    Добавить комментарий