Code Monkey home page Code Monkey logo

Comments (5)

isovector avatar isovector commented on June 22, 2024

@alanz this is my latest blocker on the hls saga. Is addAnnotationsForPretty broken, or am I just using the wrong function here?

from ghc-exactprint.

isovector avatar isovector commented on June 22, 2024

I spent a few hours digging into ghc-exactprint, but the craziness that is this state machine is far beyond my ability to fix.

from ghc-exactprint.

isovector avatar isovector commented on June 22, 2024

This also happens even with unique src spans:

{-# LANGUAGE LambdaCase #-}

module Test where

import Language.Haskell.GHC.ExactPrint
import OccName
import HsExpr
import HsPat
import RdrName
import GHC
import BasicTypes
import Generics.SYB


z :: LHsExpr GhcPs
z = noLoc $ HsVar NoExt $ noLoc $ Unqual $ mkVarOcc "hi"

c :: LHsExpr GhcPs
c = noLoc $ HsCase noExt z $ MG noExt (noLoc
  [ noLoc $ Match noExt CaseAlt [noLoc $ WildPat noExt] $ GRHSs noExt [noLoc $ GRHS noExt [] z] $ noLoc $ EmptyLocalBinds noExt
  , noLoc $ Match noExt CaseAlt [noLoc $ WildPat noExt] $ GRHSs noExt [noLoc $ GRHS noExt [] z] $ noLoc $ EmptyLocalBinds noExt
  , noLoc $ Match noExt CaseAlt [noLoc $ WildPat noExt] $ GRHSs noExt [noLoc $ GRHS noExt [] z] $ noLoc $ EmptyLocalBinds noExt
  ]) Generated


mkSpans :: LHsExpr GhcPs -> LHsExpr GhcPs
mkSpans z =
  let (a, _, _) = runTransform mempty $ do
        everywhereM
          (mkM $ \case
            _ -> uniqueSrcSpanT
          ) z
   in a

c2 = mkSpans c



blarg :: String
blarg =
  let anns = addAnnotationsForPretty [] c2 mempty
   in exactPrint c2 anns

from ghc-exactprint.

isovector avatar isovector commented on June 22, 2024

Result from showAnnData:

({ ghc-exactprint:-1:0 }
 Just (Ann (DP (0,0)) [] [] [((G AnnCase),DP (0,1)),((G AnnOf),DP (0,1))] Nothing Nothing)
 (HsCase
  (NoExt)
  ({ ghc-exactprint:-1:1 }
   Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)
   (HsVar
    (NoExt)
    ({ ghc-exactprint:-1:2 }
     Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,1))] Nothing Nothing)
     (Unqual {OccName: hi (v, Var Val )}))))
  (MG
   (NoExt)
   ({ ghc-exactprint:-1:3 }
    Nothing
    [
     ({ ghc-exactprint:-1:4 }
      Just (Ann (DP (1,2)) [] [] [] Nothing Nothing)
      (Match
       (NoExt)
       (CaseAlt)
       [
        (WildPat
         (NoExt))]
       (GRHSs
        (NoExt)
        [
         ({ ghc-exactprint:-1:5 }
          Just (Ann (DP (0,0)) [] [] [((G AnnRarrow),DP (0,1))] Nothing Nothing)
          (GRHS
           (NoExt)
           []
           ({ ghc-exactprint:-1:6 }
            Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)
            (HsVar
             (NoExt)
             ({ ghc-exactprint:-1:7 }
              Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,1))] Nothing Nothing)
              (Unqual {OccName: hi (v, Var Val )}))))))]
        ({ ghc-exactprint:-1:8 }
         Nothing
         (EmptyLocalBinds
          (NoExt)))))),
     ({ ghc-exactprint:-1:9 }
      Just (Ann (DP (1,0)) [] [] [] Nothing Nothing)
      (Match
       (NoExt)
       (CaseAlt)
       [
        (WildPat
         (NoExt))]
       (GRHSs
        (NoExt)
        [
         ({ ghc-exactprint:-1:10 }
          Just (Ann (DP (0,0)) [] [] [((G AnnRarrow),DP (0,1))] Nothing Nothing)
          (GRHS
           (NoExt)
           []
           ({ ghc-exactprint:-1:11 }
            Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)
            (HsVar
             (NoExt)
             ({ ghc-exactprint:-1:12 }
              Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,1))] Nothing Nothing)
              (Unqual {OccName: hi (v, Var Val )}))))))]
        ({ ghc-exactprint:-1:13 }
         Nothing
         (EmptyLocalBinds
          (NoExt)))))),
     ({ ghc-exactprint:-1:14 }
      Just (Ann (DP (1,0)) [] [] [] Nothing Nothing)
      (Match
       (NoExt)
       (CaseAlt)
       [
        (WildPat
         (NoExt))]
       (GRHSs
        (NoExt)
        [
         ({ ghc-exactprint:-1:15 }
          Just (Ann (DP (0,0)) [] [] [((G AnnRarrow),DP (0,1))] Nothing Nothing)
          (GRHS
           (NoExt)
           []
           ({ ghc-exactprint:-1:16 }
            Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)
            (HsVar
             (NoExt)
             ({ ghc-exactprint:-1:17 }
              Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,1))] Nothing Nothing)
              (Unqual {OccName: hi (v, Var Val )}))))))]
        ({ ghc-exactprint:-1:18 }
         Nothing
         (EmptyLocalBinds
          (NoExt))))))])
   (Generated))))

from ghc-exactprint.

alanz avatar alanz commented on June 22, 2024

I just created a file

module Issue91 where

-- Based on https://github.com/alanz/ghc-exactprint/issues/91

foo = case hi of
        _ -> hi
        _ -> hi
        _ -> hi

and ran a test of mkPrettyRoundtrip "ghc88" "Issue91.hs" on it. It passed, meaning the ast printed from the new annotations matched the original AST`

from ghc-exactprint.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.