{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Inferno.Parse.Commented where

import Data.List.NonEmpty (fromList, toList)
import Inferno.Types.Syntax

insertCommentIntoImport :: Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport :: Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport Comment SourcePos
comment Import SourcePos
i =
  let (SourcePos
startE, SourcePos
endE) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Import SourcePos
i
   in if SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
startE
        then forall pos. Comment pos -> Import pos -> Import pos
ICommentAbove Comment SourcePos
comment Import SourcePos
i
        else -- if the comment starts after the current block then, either

          if SourcePos
endE forall a. Ord a => a -> a -> Bool
<= SourcePos
startC
            then
              let SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
eLine} = SourcePos
endE
                  SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
cLine} = SourcePos
startC
               in -- it is on the same line as the block
                  if Pos
eLine forall a. Eq a => a -> a -> Bool
== Pos
cLine
                    then forall pos. Import pos -> Comment pos -> Import pos
ICommentAfter Import SourcePos
i Comment SourcePos
comment
                    else -- otherwise it is below the block
                      forall pos. Import pos -> Comment pos -> Import pos
ICommentBelow Import SourcePos
i Comment SourcePos
comment
            else -- if the comment is neither before nor after the block, it must be within the expression
            case Import SourcePos
i of
              ICommentAfter Import SourcePos
i1 Comment SourcePos
c -> forall pos. Import pos -> Comment pos -> Import pos
ICommentAfter (Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport Comment SourcePos
comment Import SourcePos
i1) Comment SourcePos
c
              ICommentBelow Import SourcePos
i1 Comment SourcePos
c -> forall pos. Import pos -> Comment pos -> Import pos
ICommentBelow (Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport Comment SourcePos
comment Import SourcePos
i1) Comment SourcePos
c
              Import SourcePos
_ -> Import SourcePos
i
  where
    (SourcePos
startC, SourcePos
endC) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
comment

insertCommentIntoPat :: Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat :: forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e =
  let (SourcePos
startE, SourcePos
endE) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Pat hash SourcePos
e
   in if SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
startE
        then forall hash pos. Comment pos -> Pat hash pos -> Pat hash pos
PCommentAbove Comment SourcePos
comment Pat hash SourcePos
e
        else -- if the comment starts after the current block then, either

          if SourcePos
endE forall a. Ord a => a -> a -> Bool
<= SourcePos
startC
            then
              let SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
eLine} = SourcePos
endE
                  SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
cLine} = SourcePos
startC
               in -- it is on the same line as the block
                  if Pos
eLine forall a. Eq a => a -> a -> Bool
== Pos
cLine
                    then forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentAfter Pat hash SourcePos
e Comment SourcePos
comment
                    else -- otherwise it is below the block
                      forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentBelow Pat hash SourcePos
e Comment SourcePos
comment
            else -- if the comment is neither before nor after the block, it must be within the expression
            case Pat hash SourcePos
e of
              PTuple SourcePos
p1 TList (Pat hash SourcePos, Maybe SourcePos)
es1 SourcePos
p2 -> forall hash pos.
pos -> TList (Pat hash pos, Maybe pos) -> pos -> Pat hash pos
PTuple SourcePos
p1 (forall a. [a] -> TList a
tListFromList forall a b. (a -> b) -> a -> b
$ [(Pat hash SourcePos, Maybe SourcePos)]
-> [(Pat hash SourcePos, Maybe SourcePos)]
insertTuple forall a b. (a -> b) -> a -> b
$ forall a. TList a -> [a]
tListToList TList (Pat hash SourcePos, Maybe SourcePos)
es1) SourcePos
p2
              POne SourcePos
p Pat hash SourcePos
e1 -> forall hash pos. pos -> Pat hash pos -> Pat hash pos
POne SourcePos
p forall a b. (a -> b) -> a -> b
$ forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e1
              PCommentAfter Pat hash SourcePos
e1 Comment SourcePos
c -> forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentAfter (forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e1) Comment SourcePos
c
              PCommentBelow Pat hash SourcePos
e1 Comment SourcePos
c -> forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentBelow (forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e1) Comment SourcePos
c
              Pat hash SourcePos
_ -> Pat hash SourcePos
e
  where
    (SourcePos
startC, SourcePos
endC) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
comment

    insertTuple :: [(Pat hash SourcePos, Maybe SourcePos)]
-> [(Pat hash SourcePos, Maybe SourcePos)]
insertTuple = \case
      [] -> []
      [(Pat hash SourcePos
e1, Maybe SourcePos
mp)] -> [(forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e1, Maybe SourcePos
mp)]
      x :: (Pat hash SourcePos, Maybe SourcePos)
x@(Pat hash SourcePos
e1, Just SourcePos
commaPos) : [(Pat hash SourcePos, Maybe SourcePos)]
xs ->
        if SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
commaPos
          then (forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
e1, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(Pat hash SourcePos, Maybe SourcePos)]
xs
          else (Pat hash SourcePos, Maybe SourcePos)
x forall a. a -> [a] -> [a]
: [(Pat hash SourcePos, Maybe SourcePos)]
-> [(Pat hash SourcePos, Maybe SourcePos)]
insertTuple [(Pat hash SourcePos, Maybe SourcePos)]
xs
      -- this case should be unreachable
      (Pat hash SourcePos, Maybe SourcePos)
x : [(Pat hash SourcePos, Maybe SourcePos)]
xs -> (Pat hash SourcePos, Maybe SourcePos)
x forall a. a -> [a] -> [a]
: [(Pat hash SourcePos, Maybe SourcePos)]
-> [(Pat hash SourcePos, Maybe SourcePos)]
insertTuple [(Pat hash SourcePos, Maybe SourcePos)]
xs

insertCommentIntoExpr :: Comment SourcePos -> Expr hash SourcePos -> Expr hash SourcePos
insertCommentIntoExpr :: forall hash.
Comment SourcePos -> Expr hash SourcePos -> Expr hash SourcePos
insertCommentIntoExpr Comment SourcePos
comment Expr hash SourcePos
expr = forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
expr
  where
    (SourcePos
startC, SourcePos
endC) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
comment
    commentIsWithin :: SourcePos -> SourcePos -> Bool
commentIsWithin SourcePos
s SourcePos
e = SourcePos
s forall a. Ord a => a -> a -> Bool
<= SourcePos
startC Bool -> Bool -> Bool
&& SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
e
    commentIsBefore :: SourcePos -> Bool
commentIsBefore SourcePos
p = SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
p

    istrGo' :: IStr f (SourcePos, Expr hash SourcePos, SourcePos) -> IStr f (SourcePos, Expr hash SourcePos, SourcePos)
    istrGo' :: forall (f :: Bool) hash.
IStr f (SourcePos, Expr hash SourcePos, SourcePos)
-> IStr f (SourcePos, Expr hash SourcePos, SourcePos)
istrGo' IStr f (SourcePos, Expr hash SourcePos, SourcePos)
ISEmpty = forall e. IStr 'True e
ISEmpty
    istrGo' (ISStr Text
x IStr 'True (SourcePos, Expr hash SourcePos, SourcePos)
xs) = forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
x forall a b. (a -> b) -> a -> b
$ forall (f :: Bool) hash.
IStr f (SourcePos, Expr hash SourcePos, SourcePos)
-> IStr f (SourcePos, Expr hash SourcePos, SourcePos)
istrGo' IStr 'True (SourcePos, Expr hash SourcePos, SourcePos)
xs
    istrGo' (ISExpr (SourcePos
p1, Expr hash SourcePos
e, SourcePos
p2) IStr f1 (SourcePos, Expr hash SourcePos, SourcePos)
xs) =
      if SourcePos -> SourcePos -> Bool
commentIsWithin SourcePos
p1 SourcePos
p2
        then forall (f1 :: Bool) e.
Typeable f1 =>
e -> IStr f1 e -> IStr 'True e
ISExpr (SourcePos
p1, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e, SourcePos
p2) IStr f1 (SourcePos, Expr hash SourcePos, SourcePos)
xs
        else forall (f1 :: Bool) e.
Typeable f1 =>
e -> IStr f1 e -> IStr 'True e
ISExpr (SourcePos
p1, Expr hash SourcePos
e, SourcePos
p2) forall a b. (a -> b) -> a -> b
$ forall (f :: Bool) hash.
IStr f (SourcePos, Expr hash SourcePos, SourcePos)
-> IStr f (SourcePos, Expr hash SourcePos, SourcePos)
istrGo' IStr f1 (SourcePos, Expr hash SourcePos, SourcePos)
xs

    tupleGo' :: [(Expr hash SourcePos, Maybe SourcePos)] -> [(Expr hash SourcePos, Maybe SourcePos)]
    tupleGo' :: forall hash.
[(Expr hash SourcePos, Maybe SourcePos)]
-> [(Expr hash SourcePos, Maybe SourcePos)]
tupleGo' = \case
      [] -> []
      [(Expr hash SourcePos
e, Maybe SourcePos
mp)] -> [(forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e, Maybe SourcePos
mp)]
      x :: (Expr hash SourcePos, Maybe SourcePos)
x@(Expr hash SourcePos
e, Just SourcePos
commaPos) : [(Expr hash SourcePos, Maybe SourcePos)]
xs ->
        if SourcePos -> Bool
commentIsBefore SourcePos
commaPos
          then (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(Expr hash SourcePos, Maybe SourcePos)]
xs
          else (Expr hash SourcePos, Maybe SourcePos)
x forall a. a -> [a] -> [a]
: forall hash.
[(Expr hash SourcePos, Maybe SourcePos)]
-> [(Expr hash SourcePos, Maybe SourcePos)]
tupleGo' [(Expr hash SourcePos, Maybe SourcePos)]
xs
      [(Expr hash SourcePos, Maybe SourcePos)]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

    caseGo' ::
      [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)] ->
      [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
    caseGo' :: forall hash.
[(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
-> [(SourcePos, Pat hash SourcePos, SourcePos,
     Expr hash SourcePos)]
caseGo' = \case
      [] -> []
      [(SourcePos
ofPos, Pat hash SourcePos
pat, SourcePos
arrPos, Expr hash SourcePos
e)] ->
        if SourcePos -> Bool
commentIsBefore SourcePos
arrPos
          then [(SourcePos
ofPos, forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
pat, SourcePos
arrPos, Expr hash SourcePos
e)]
          else [(SourcePos
ofPos, Pat hash SourcePos
pat, SourcePos
arrPos, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e)]
      x :: (SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)
x@(SourcePos
ofPos, Pat hash SourcePos
pat, SourcePos
arrPos, Expr hash SourcePos
e) : xs :: [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
xs@((SourcePos
ofPos2, Pat hash SourcePos
_, SourcePos
_, Expr hash SourcePos
_) : [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
_) ->
        if SourcePos -> Bool
commentIsBefore SourcePos
arrPos
          then (SourcePos
ofPos, forall hash.
Comment SourcePos -> Pat hash SourcePos -> Pat hash SourcePos
insertCommentIntoPat Comment SourcePos
comment Pat hash SourcePos
pat, SourcePos
arrPos, Expr hash SourcePos
e) forall a. a -> [a] -> [a]
: [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
xs
          else
            if SourcePos -> SourcePos -> Bool
commentIsWithin SourcePos
arrPos SourcePos
ofPos2
              then (SourcePos
ofPos, Pat hash SourcePos
pat, SourcePos
arrPos, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e) forall a. a -> [a] -> [a]
: [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
xs
              else (SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)
x forall a. a -> [a] -> [a]
: forall hash.
[(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
-> [(SourcePos, Pat hash SourcePos, SourcePos,
     Expr hash SourcePos)]
caseGo' [(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
xs

    arrayCompGo' ::
      Maybe (a1, Expr hash SourcePos) ->
      [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)] ->
      ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)], Maybe (a1, Expr hash SourcePos))
    arrayCompGo' :: forall a1 hash a0 b0 c0.
Maybe (a1, Expr hash SourcePos)
-> [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
-> ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)],
    Maybe (a1, Expr hash SourcePos))
arrayCompGo' Maybe (a1, Expr hash SourcePos)
mcond = \case
      [] -> ([], case Maybe (a1, Expr hash SourcePos)
mcond of Just (a1
p, Expr hash SourcePos
e) -> forall a. a -> Maybe a
Just (a1
p, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e); Maybe (a1, Expr hash SourcePos)
Nothing -> forall a. Maybe a
Nothing)
      [(a0
p1, b0
ident, c0
p2, Expr hash SourcePos
e, Maybe SourcePos
Nothing)] -> ([(a0
p1, b0
ident, c0
p2, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e, forall a. Maybe a
Nothing)], Maybe (a1, Expr hash SourcePos)
mcond)
      x :: (a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)
x@(a0
p1, b0
ident, c0
p2, Expr hash SourcePos
e, Just SourcePos
commaPos) : [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
xs ->
        if SourcePos -> Bool
commentIsBefore SourcePos
commaPos
          then ((a0
p1, b0
ident, c0
p2, forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
xs, Maybe (a1, Expr hash SourcePos)
mcond)
          else let ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
xs', Maybe (a1, Expr hash SourcePos)
mcond') = forall a1 hash a0 b0 c0.
Maybe (a1, Expr hash SourcePos)
-> [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
-> ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)],
    Maybe (a1, Expr hash SourcePos))
arrayCompGo' Maybe (a1, Expr hash SourcePos)
mcond [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
xs in ((a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)
x forall a. a -> [a] -> [a]
: [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
xs', Maybe (a1, Expr hash SourcePos)
mcond')
      [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

    importsGo' :: [(Import SourcePos, Maybe SourcePos)]
-> [(Import SourcePos, Maybe SourcePos)]
importsGo' = \case
      [] -> []
      [(Import SourcePos
i, Maybe SourcePos
mp)] -> [(Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport Comment SourcePos
comment Import SourcePos
i, Maybe SourcePos
mp)]
      x :: (Import SourcePos, Maybe SourcePos)
x@(Import SourcePos
i, Just SourcePos
commaPos) : [(Import SourcePos, Maybe SourcePos)]
xs ->
        if SourcePos -> Bool
commentIsBefore SourcePos
commaPos
          then (Comment SourcePos -> Import SourcePos -> Import SourcePos
insertCommentIntoImport Comment SourcePos
comment Import SourcePos
i, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(Import SourcePos, Maybe SourcePos)]
xs
          else (Import SourcePos, Maybe SourcePos)
x forall a. a -> [a] -> [a]
: [(Import SourcePos, Maybe SourcePos)]
-> [(Import SourcePos, Maybe SourcePos)]
importsGo' [(Import SourcePos, Maybe SourcePos)]
xs
      [(Import SourcePos, Maybe SourcePos)]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

    go' :: Expr hash SourcePos -> Expr hash SourcePos
    go' :: forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
x = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall hash. [Expr hash SourcePos] -> [Expr hash SourcePos]
go [Expr hash SourcePos
x]

    go :: [Expr hash SourcePos] -> [Expr hash SourcePos]
    go :: forall hash. [Expr hash SourcePos] -> [Expr hash SourcePos]
go =
      \case
        [] -> []
        (Expr hash SourcePos
e : [Expr hash SourcePos]
es) ->
          let (SourcePos
startE, SourcePos
endE) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Expr hash SourcePos
e
           in if SourcePos
endC forall a. Ord a => a -> a -> Bool
<= SourcePos
startE
                then forall hash pos. Comment pos -> Expr hash pos -> Expr hash pos
CommentAbove Comment SourcePos
comment Expr hash SourcePos
e forall a. a -> [a] -> [a]
: [Expr hash SourcePos]
es
                else -- if the comment starts after the current block then, either

                  if SourcePos
endE forall a. Ord a => a -> a -> Bool
<= SourcePos
startC
                    then
                      let SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
eLine} = SourcePos
endE
                          SourcePos {sourceLine :: SourcePos -> Pos
sourceLine = Pos
cLine} = SourcePos
startC
                       in -- it is on the same line as the block
                          if Pos
eLine forall a. Eq a => a -> a -> Bool
== Pos
cLine
                            then forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentAfter Expr hash SourcePos
e Comment SourcePos
comment forall a. a -> [a] -> [a]
: [Expr hash SourcePos]
es
                            else -- otherwise it is below the block

                            -- in case `e` is the last element, we attach the comment below `e`

                            case [Expr hash SourcePos]
es of
                              [] -> [forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentBelow Expr hash SourcePos
e Comment SourcePos
comment]
                              [Expr hash SourcePos]
_ ->
                                -- in case we have more blocks in the list, we instead proceed to attach the comment lower down
                                Expr hash SourcePos
e forall a. a -> [a] -> [a]
: forall hash. [Expr hash SourcePos] -> [Expr hash SourcePos]
go [Expr hash SourcePos]
es
                    else -- if the comment is neither before nor after the block, it must be within the expression

                      ( case Expr hash SourcePos
e of
                          App Expr hash SourcePos
e1 Expr hash SourcePos
e2 -> let res :: [Expr hash SourcePos]
res = forall hash. [Expr hash SourcePos] -> [Expr hash SourcePos]
go [Expr hash SourcePos
e1, Expr hash SourcePos
e2] in forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos
App ([Expr hash SourcePos]
res forall a. [a] -> Int -> a
!! Int
0) ([Expr hash SourcePos]
res forall a. [a] -> Int -> a
!! Int
1)
                          Lam SourcePos
p1 NonEmpty (SourcePos, Maybe ExtIdent)
xs SourcePos
p2 Expr hash SourcePos
body -> forall hash pos.
pos
-> NonEmpty (pos, Maybe ExtIdent)
-> pos
-> Expr hash pos
-> Expr hash pos
Lam SourcePos
p1 NonEmpty (SourcePos, Maybe ExtIdent)
xs SourcePos
p2 forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
body
                          Let SourcePos
p1 SourcePos
p2 ImplExpl
v SourcePos
p3 Expr hash SourcePos
e1 SourcePos
posOfIn Expr hash SourcePos
e2 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
posOfIn
                              then forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
p1 SourcePos
p2 ImplExpl
v SourcePos
p3 (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) SourcePos
posOfIn Expr hash SourcePos
e2
                              else forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
p1 SourcePos
p2 ImplExpl
v SourcePos
p3 Expr hash SourcePos
e1 SourcePos
posOfIn forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e2
                          InterpolatedString SourcePos
p1 (SomeIStr IStr f (SourcePos, Expr hash SourcePos, SourcePos)
xs) SourcePos
p2 -> forall hash pos.
pos -> SomeIStr (pos, Expr hash pos, pos) -> pos -> Expr hash pos
InterpolatedString SourcePos
p1 (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall (f :: Bool) hash.
IStr f (SourcePos, Expr hash SourcePos, SourcePos)
-> IStr f (SourcePos, Expr hash SourcePos, SourcePos)
istrGo' IStr f (SourcePos, Expr hash SourcePos, SourcePos)
xs) SourcePos
p2
                          If SourcePos
ifPos Expr hash SourcePos
c SourcePos
thenPos Expr hash SourcePos
t SourcePos
elsePos Expr hash SourcePos
f ->
                            if SourcePos -> SourcePos -> Bool
commentIsWithin SourcePos
ifPos SourcePos
thenPos
                              then forall hash pos.
pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
If SourcePos
ifPos (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
c) SourcePos
thenPos Expr hash SourcePos
t SourcePos
elsePos Expr hash SourcePos
f
                              else
                                if SourcePos -> SourcePos -> Bool
commentIsWithin SourcePos
thenPos SourcePos
elsePos
                                  then forall hash pos.
pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
If SourcePos
ifPos Expr hash SourcePos
c SourcePos
thenPos (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
t) SourcePos
elsePos Expr hash SourcePos
f
                                  else forall hash pos.
pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
If SourcePos
ifPos Expr hash SourcePos
c SourcePos
thenPos Expr hash SourcePos
t SourcePos
elsePos (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
f)
                          Op Expr hash SourcePos
e1 SourcePos
posOfOp hash
hash (Int, InfixFixity)
opMeta Scoped ModuleName
ns Ident
op Expr hash SourcePos
e2 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
posOfOp
                              then forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) SourcePos
posOfOp hash
hash (Int, InfixFixity)
opMeta Scoped ModuleName
ns Ident
op Expr hash SourcePos
e2
                              else forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr hash SourcePos
e1 SourcePos
posOfOp hash
hash (Int, InfixFixity)
opMeta Scoped ModuleName
ns Ident
op forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e2
                          PreOp SourcePos
posOfOp hash
hash Int
opMeta Scoped ModuleName
ns Ident
op Expr hash SourcePos
e1 ->
                            forall hash pos.
pos
-> hash
-> Int
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
PreOp SourcePos
posOfOp hash
hash Int
opMeta Scoped ModuleName
ns Ident
op forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          Tuple SourcePos
p1 TList (Expr hash SourcePos, Maybe SourcePos)
es1 SourcePos
p2 -> forall hash pos.
pos -> TList (Expr hash pos, Maybe pos) -> pos -> Expr hash pos
Tuple SourcePos
p1 (forall a. [a] -> TList a
tListFromList forall a b. (a -> b) -> a -> b
$ forall hash.
[(Expr hash SourcePos, Maybe SourcePos)]
-> [(Expr hash SourcePos, Maybe SourcePos)]
tupleGo' forall a b. (a -> b) -> a -> b
$ forall a. TList a -> [a]
tListToList TList (Expr hash SourcePos, Maybe SourcePos)
es1) SourcePos
p2
                          One SourcePos
p Expr hash SourcePos
e1 -> forall hash pos. pos -> Expr hash pos -> Expr hash pos
One SourcePos
p forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          Assert SourcePos
p1 Expr hash SourcePos
c SourcePos
inPos Expr hash SourcePos
e1 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
inPos
                              then forall hash pos.
pos -> Expr hash pos -> pos -> Expr hash pos -> Expr hash pos
Assert SourcePos
p1 (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
c) SourcePos
inPos Expr hash SourcePos
e1
                              else forall hash pos.
pos -> Expr hash pos -> pos -> Expr hash pos -> Expr hash pos
Assert SourcePos
p1 Expr hash SourcePos
c SourcePos
inPos forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          Case SourcePos
p1 Expr hash SourcePos
e_c SourcePos
brPos NonEmpty
  (SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)
cases SourcePos
p2 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
brPos
                              then forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case SourcePos
p1 (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e_c) SourcePos
brPos NonEmpty
  (SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)
cases SourcePos
p2
                              else forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case SourcePos
p1 Expr hash SourcePos
e_c SourcePos
brPos (forall a. [a] -> NonEmpty a
fromList forall a b. (a -> b) -> a -> b
$ forall hash.
[(SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)]
-> [(SourcePos, Pat hash SourcePos, SourcePos,
     Expr hash SourcePos)]
caseGo' forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty
  (SourcePos, Pat hash SourcePos, SourcePos, Expr hash SourcePos)
cases) SourcePos
p2
                          Array SourcePos
p1 [(Expr hash SourcePos, Maybe SourcePos)]
es1 SourcePos
p2 -> forall hash pos.
pos -> [(Expr hash pos, Maybe pos)] -> pos -> Expr hash pos
Array SourcePos
p1 (forall hash.
[(Expr hash SourcePos, Maybe SourcePos)]
-> [(Expr hash SourcePos, Maybe SourcePos)]
tupleGo' [(Expr hash SourcePos, Maybe SourcePos)]
es1) SourcePos
p2
                          ArrayComp SourcePos
p1 Expr hash SourcePos
e1 SourcePos
posOfBar NonEmpty
  (SourcePos, Ident, SourcePos, Expr hash SourcePos, Maybe SourcePos)
args Maybe (SourcePos, Expr hash SourcePos)
mcond SourcePos
p2 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
posOfBar
                              then forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
-> Maybe (pos, Expr hash pos)
-> pos
-> Expr hash pos
ArrayComp SourcePos
p1 (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) SourcePos
posOfBar NonEmpty
  (SourcePos, Ident, SourcePos, Expr hash SourcePos, Maybe SourcePos)
args Maybe (SourcePos, Expr hash SourcePos)
mcond SourcePos
p2
                              else
                                let ([(SourcePos, Ident, SourcePos, Expr hash SourcePos,
  Maybe SourcePos)]
args', Maybe (SourcePos, Expr hash SourcePos)
mcond') = forall a1 hash a0 b0 c0.
Maybe (a1, Expr hash SourcePos)
-> [(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)]
-> ([(a0, b0, c0, Expr hash SourcePos, Maybe SourcePos)],
    Maybe (a1, Expr hash SourcePos))
arrayCompGo' Maybe (SourcePos, Expr hash SourcePos)
mcond forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty
  (SourcePos, Ident, SourcePos, Expr hash SourcePos, Maybe SourcePos)
args
                                 in forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
-> Maybe (pos, Expr hash pos)
-> pos
-> Expr hash pos
ArrayComp SourcePos
p1 Expr hash SourcePos
e1 SourcePos
posOfBar (forall a. [a] -> NonEmpty a
fromList forall a b. (a -> b) -> a -> b
$ [(SourcePos, Ident, SourcePos, Expr hash SourcePos,
  Maybe SourcePos)]
args') Maybe (SourcePos, Expr hash SourcePos)
mcond' SourcePos
p2
                          CommentAfter Expr hash SourcePos
e1 Comment SourcePos
c -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentAfter (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) Comment SourcePos
c
                          CommentBelow Expr hash SourcePos
e1 Comment SourcePos
c -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentBelow (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) Comment SourcePos
c
                          Bracketed SourcePos
p1 Expr hash SourcePos
e1 SourcePos
p2 -> forall hash pos. pos -> Expr hash pos -> pos -> Expr hash pos
Bracketed SourcePos
p1 (forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1) SourcePos
p2
                          RenameModule SourcePos
p1 ModuleName
m1 SourcePos
p2 ModuleName
m2 SourcePos
p3 Expr hash SourcePos
e1 -> forall hash pos.
pos
-> ModuleName
-> pos
-> ModuleName
-> pos
-> Expr hash pos
-> Expr hash pos
RenameModule SourcePos
p1 ModuleName
m1 SourcePos
p2 ModuleName
m2 SourcePos
p3 forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          OpenModule SourcePos
p1 hash
hash ModuleName
mn [] SourcePos
inPos Expr hash SourcePos
e1 -> forall hash pos.
pos
-> hash
-> ModuleName
-> [(Import pos, Maybe pos)]
-> pos
-> Expr hash pos
-> Expr hash pos
OpenModule SourcePos
p1 hash
hash ModuleName
mn [] SourcePos
inPos forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          OpenModule SourcePos
p1 hash
hash ModuleName
mn [(Import SourcePos, Maybe SourcePos)]
is SourcePos
inPos Expr hash SourcePos
e1 ->
                            if SourcePos -> Bool
commentIsBefore SourcePos
inPos
                              then forall hash pos.
pos
-> hash
-> ModuleName
-> [(Import pos, Maybe pos)]
-> pos
-> Expr hash pos
-> Expr hash pos
OpenModule SourcePos
p1 hash
hash ModuleName
mn ([(Import SourcePos, Maybe SourcePos)]
-> [(Import SourcePos, Maybe SourcePos)]
importsGo' [(Import SourcePos, Maybe SourcePos)]
is) SourcePos
inPos Expr hash SourcePos
e1
                              else forall hash pos.
pos
-> hash
-> ModuleName
-> [(Import pos, Maybe pos)]
-> pos
-> Expr hash pos
-> Expr hash pos
OpenModule SourcePos
p1 hash
hash ModuleName
mn [(Import SourcePos, Maybe SourcePos)]
is SourcePos
inPos forall a b. (a -> b) -> a -> b
$ forall hash. Expr hash SourcePos -> Expr hash SourcePos
go' Expr hash SourcePos
e1
                          Expr hash SourcePos
_ -> Expr hash SourcePos
e
                      ) forall a. a -> [a] -> [a]
:
                      [Expr hash SourcePos]
es

insertCommentsIntoExpr :: [Comment SourcePos] -> Expr hash SourcePos -> Expr hash SourcePos
insertCommentsIntoExpr :: forall hash.
[Comment SourcePos] -> Expr hash SourcePos -> Expr hash SourcePos
insertCommentsIntoExpr = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall hash.
Comment SourcePos -> Expr hash SourcePos -> Expr hash SourcePos
insertCommentIntoExpr)