lspitzner / brittany

haskell source code formatter
GNU Affero General Public License v3.0
690 stars 72 forks source link

More "walking comment" bugs #253

Open eborden opened 5 years ago

eborden commented 5 years ago

It seems the "walking comment" problem still exists. It arises only within instance bodies with vertical alignment.

Here are the examples found:

instance ToJSON CompleteMathQuestion where
  toJSON CompleteMathQuestion {..} = Object $ core <> extra
   where
    -- We don't want to repeat the `QuestionExtra` instance here so we smush the two parts together
    (Object core) = object
      [ "id" .= completeMathQuestionId
      , "is-deprecated" .= completeMathQuestionIsDeprecated
      , "stem-id" .= completeMathQuestionStemId
      , "skill-id" .= completeMathQuestionSkillId
      , "answer-type" .= completeMathQuestionAnswerType
      , "is-printable" .= completeMathQuestionIsPrintable
      , "question-text" .= completeMathQuestionText
      , "question-diagram-name" .= completeMathQuestionDiagramName
      , "summative-test" .= completeMathQuestionSummativeTest
      , "answers" .= completeMathQuestionAnswers
      , "worth" .= completeMathQuestionWorth
      ]
    (Object extra) = toJSON completeMathQuestionExtra
instance Ord StandardCode where
  StandardCode gradeL domainL tailL `compare` StandardCode gradeR domainR tailR
    =
      -- It doesn't make sense to order standards from different domains, but we already have too much code relying on this.
      domainL
      `compare` domainR
      <> gradeL
      `compare` gradeR
      <> tailL
      `compare` tailR
instance Arbitrary BadgeAward where
  arbitrary =
    BadgeAward
      <$> arbitrary
      <*> arbitrary
      <*> arbitrary
      -- This is a garbage value for testing. Only the frontend utilizes the meta data.
      <*> pure Nothing
      <*> arbitrary
instance Arbitrary MathStandardAssignmentAnswer where
  arbitrary =
    MathStandardAssignmentAnswer
      <$> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> (getPositive <$> arbitrary)
      <*> arbitrary
      <*> arbitrary
      -- NB. All new answers will have an associated @answer@
      <*> (Just <$> arbitrary)
instance ToJSON BadgeAwardResponse where
  toJSON m = case m of
    -- Flattens the structure. Aeson's derivations only allow specification of
    -- the "tag" and "contents" field (through @sumEncoding@), so we need
    -- something customized.
    Static response ->
      toJSON $ object ["tag" .= String "static"] `WithMetadata` response
    Tier response ->
      toJSON $ object ["tag" .= String "tier"] `WithMetadata` response
    Category response ->
      toJSON $ object ["tag" .= String "category"] `WithMetadata` response
    Level response ->
      toJSON $ object ["tag" .= String "level"] `WithMetadata` response
    SubjectExpertResponse response ->
      toJSON $ object ["tag" .= String "subject-expert"] `WithMetadata` response

instance FromJSON MathAssessmentMetadata where
  parseJSON = A.withObject "MathAssessment metadata" $ \o ->
    -- must be ordered from most specific to least specific parsers
    Legacy
      . MAMGradeManyStandards
      <$> parseJSON (Object o) <|> Legacy . MAMGradeDomainStandard
      <$> parseJSON (Object o) <|> Legacy . MAMGradeDomain
      <$> parseJSON (Object o) <|> MathAssessmentMetadata
      <$> parseJSON (Object o)
      -- <?> fail "could not parse"
instance ToJSON Metrics where
  toJSON Metrics {..} = object
    [ "metrics" .= object
        [ "minutes" .= (getSum seconds `div` 60)

        -- Underscores in this JSON are intentional
        --
        -- Clever Goals utilizes a `noun_verb` "syntax" for goal naming. The
        -- properties correlate directly with a goal's name. In this way goal
        -- naming is dynamic and can be thought of as a simple key value store.
        -- The underscore separates the two components of the goal's name. This
        -- expressily dissallows multiple underscores in any goal name.
        --
        -- `minutes` is a fixed property and diverges from the `noun_verb` syntax.
        --
        , "math_completed" .= mathCompleted
        , "ela_completed" .= elaCompleted
        , "science_completed" .= scienceCompleted
        , "socialstudies_completed" .= socialStudiesCompleted
        ]
    ]
instance FromNamedRecord CompleteMathQuestion where
  parseNamedRecord m = do
    -- Extract question id early to improve error reporting
    completeMathQuestionId <- m .: "id"
    case CSV.runParser (parseCompleteMathQuestion completeMathQuestionId m) of
      Left msg -> M.fail
        (T.unpack (questionIdtoText completeMathQuestionId) ++ ": " ++ msg)
      Right val -> pure val
RaoulHC commented 5 years ago

Seems you also get a walking comment bug if you have a comment between a let and an in line that are long enough:

testMethod :: String -> String -> String -> String -> String
testMethod foo bar baz qux =
  -- Some comment explaining the let expressions
  let x = undefined foo bar baz qux qux baz bar :: String
  -- some comment explaining the in expression
  in  undefined foo x :: String

Every time you run brittany it will indent the in expression comment two spaces