{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Rendering of import and export lists.
module Ormolu.Printer.Meat.ImportExport
  ( p_hsmodExports,
    p_hsmodImport,
  )
where

import Control.Monad
import GHC
import HsImpExp (IE (..))
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Utils

p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports :: [LIE GhcPs] -> R ()
p_hsmodExports [] = do
  Text -> R ()
txt "("
  R ()
breakpoint'
  Text -> R ()
txt ")"
p_hsmodExports xs :: [LIE GhcPs]
xs =
  BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Layout
layout <- R Layout
getLayout
    R ()
-> (Located ((Int, Int), IE GhcPs) -> R ())
-> [Located ((Int, Int), IE GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Located ((Int, Int), IE GhcPs) -> R ())
-> Located ((Int, Int), IE GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Int), IE GhcPs) -> R ())
-> Located ((Int, Int), IE GhcPs) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (((Int, Int) -> IE GhcPs -> R ()) -> ((Int, Int), IE GhcPs) -> R ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Layout -> (Int, Int) -> IE GhcPs -> R ()
p_lie Layout
layout))) ([LIE GhcPs] -> [Located ((Int, Int), IE GhcPs)]
forall a. [Located a] -> [Located ((Int, Int), a)]
attachPositions [LIE GhcPs]
xs)

p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport ImportDecl {..} = do
  Text -> R ()
txt "import"
  R ()
space
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSource (Text -> R ()
txt "{-# SOURCE #-}")
  R ()
space
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclSafe (Text -> R ()
txt "safe")
  R ()
space
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ideclQualified (Text -> R ()
txt "qualified")
  R ()
space
  case Maybe StringLiteral
ideclPkgQual of
    Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just slit :: StringLiteral
slit -> StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
slit
  R ()
space
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located ModuleName
ideclName ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom
    case Maybe (Located ModuleName)
ideclAs of
      Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just l :: Located ModuleName
l -> do
        R ()
space
        Text -> R ()
txt "as"
        R ()
space
        Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located ModuleName
l ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom
    R ()
space
    case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
      Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (hiding :: Bool
hiding, _) ->
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hiding (Text -> R ()
txt "hiding")
    case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
      Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (_, L _ xs :: [LIE GhcPs]
xs) -> do
        R ()
breakpoint
        BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Layout
layout <- R Layout
getLayout
          R ()
-> (Located ((Int, Int), IE GhcPs) -> R ())
-> [Located ((Int, Int), IE GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Located ((Int, Int), IE GhcPs) -> R ())
-> Located ((Int, Int), IE GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Int), IE GhcPs) -> R ())
-> Located ((Int, Int), IE GhcPs) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (((Int, Int) -> IE GhcPs -> R ()) -> ((Int, Int), IE GhcPs) -> R ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Layout -> (Int, Int) -> IE GhcPs -> R ()
p_lie Layout
layout))) ([LIE GhcPs] -> [Located ((Int, Int), IE GhcPs)]
forall a. [Located a] -> [Located ((Int, Int), a)]
attachPositions [LIE GhcPs]
xs)
    R ()
newline
p_hsmodImport (XImportDecl NoExt) = String -> R ()
forall a. String -> a
notImplemented "XImportDecl"

p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()
p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()
p_lie encLayout :: Layout
encLayout (i :: Int
i, totalItems :: Int
totalItems) = \case
  IEVar NoExt l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
    Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
p_comma
  IEThingAbs NoExt l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
    Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
p_comma
  IEThingAll NoExt l1 :: LIEWrappedName (IdP GhcPs)
l1 -> do
    Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
space
    Text -> R ()
txt "(..)"
    R ()
p_comma
  IEThingWith NoExt l1 :: LIEWrappedName (IdP GhcPs)
l1 w :: IEWildcard
w xs :: [LIEWrappedName (IdP GhcPs)]
xs _ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located (IEWrappedName RdrName)
-> (IEWrappedName RdrName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
l1 IEWrappedName RdrName -> R ()
p_ieWrappedName
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      let names :: [R ()]
          names :: [R ()]
names = (IEWrappedName RdrName -> R ())
-> Located (IEWrappedName RdrName) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' IEWrappedName RdrName -> R ()
p_ieWrappedName (Located (IEWrappedName RdrName) -> R ())
-> [Located (IEWrappedName RdrName)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
xs
      BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc
        (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) R () -> R ()
sitcc
        ([R ()] -> R ()) -> [R ()] -> R ()
forall a b. (a -> b) -> a -> b
$ case IEWildcard
w of
          NoIEWildcard -> [R ()]
names
          IEWildcard n :: Int
n ->
            let (before :: [R ()]
before, after :: [R ()]
after) = Int -> [R ()] -> ([R ()], [R ()])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [R ()]
names
             in [R ()]
before [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [Text -> R ()
txt ".."] [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [R ()]
after
    R ()
p_comma
  IEModuleContents NoExt l1 :: Located ModuleName
l1 -> do
    Located ModuleName -> (ModuleName -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located ModuleName
l1 ModuleName -> R ()
p_hsmodName
    R ()
p_comma
  IEGroup NoExt n :: Int
n str :: HsDocString
str -> do
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) R ()
newline
    HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString (Int -> HaddockStyle
Asterisk Int
n) Bool
False (SrcSpanLess LHsDocString -> LHsDocString
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsDocString
SrcSpanLess LHsDocString
str)
  IEDoc NoExt str :: HsDocString
str ->
    HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
False (SrcSpanLess LHsDocString -> LHsDocString
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsDocString
SrcSpanLess LHsDocString
str)
  IEDocNamed NoExt str :: String
str -> String -> R ()
p_hsDocName String
str
  XIE NoExt -> String -> R ()
forall a. String -> a
notImplemented "XIE"
  where
    p_comma :: R ()
p_comma =
      case Layout
encLayout of
        SingleLine -> Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
totalItems) R ()
comma
        MultiLine -> R ()
comma

-- | Attach positions to 'Located' things in a list.
attachPositions ::
  [Located a] ->
  [Located ((Int, Int), a)]
attachPositions :: [Located a] -> [Located ((Int, Int), a)]
attachPositions xs :: [Located a]
xs =
  let f :: a -> GenLocated l b -> GenLocated l ((a, Int), b)
f i :: a
i (L l :: l
l x :: b
x) = l -> ((a, Int), b) -> GenLocated l ((a, Int), b)
forall l e. l -> e -> GenLocated l e
L l
l ((a
i, Int
n), b
x)
      n :: Int
n = [Located a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located a]
xs
   in (Int -> Located a -> Located ((Int, Int), a))
-> [Int] -> [Located a] -> [Located ((Int, Int), a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Located a -> Located ((Int, Int), a)
forall a l b. a -> GenLocated l b -> GenLocated l ((a, Int), b)
f [0 ..] [Located a]
xs