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

-- | Printer for fixity overrides.
module Ormolu.Fixity.Printer
  ( printDotOrmolu,
  )
where

import Data.Char qualified as Char
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict qualified as Map
import Data.Semigroup (sconcat)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder (Builder)
import Data.Text.Lazy.Builder qualified as B
import Data.Text.Lazy.Builder.Int qualified as B
import Distribution.ModuleName (ModuleName)
import Distribution.ModuleName qualified as ModuleName
import Distribution.Types.PackageName
import Ormolu.Fixity

-- | Print out a textual representation of an @.ormolu@ file.
printDotOrmolu ::
  FixityOverrides ->
  ModuleReexports ->
  Text
printDotOrmolu :: FixityOverrides -> ModuleReexports -> Text
printDotOrmolu
  (FixityOverrides Map OpName FixityInfo
fixityOverrides)
  (ModuleReexports Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
moduleReexports) =
    Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
B.toLazyText forall a b. (a -> b) -> a -> b
$
      (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OpName, FixityInfo) -> Builder
renderSingleFixityOverride forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList) Map OpName FixityInfo
fixityOverrides
        forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName, NonEmpty (Maybe PackageName, ModuleName)) -> Builder
renderSingleModuleReexport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList) Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
moduleReexports

renderSingleFixityOverride :: (OpName, FixityInfo) -> Builder
renderSingleFixityOverride :: (OpName, FixityInfo) -> Builder
renderSingleFixityOverride (OpName Text
operator, FixityInfo {Int
FixityDirection
fiPrecedence :: FixityInfo -> Int
fiDirection :: FixityInfo -> FixityDirection
fiPrecedence :: Int
fiDirection :: FixityDirection
..}) =
  forall a. Monoid a => [a] -> a
mconcat
    [ case FixityDirection
fiDirection of
        FixityDirection
InfixL -> Builder
"infixl"
        FixityDirection
InfixR -> Builder
"infixr"
        FixityDirection
InfixN -> Builder
"infix",
      Builder
" ",
      forall a. Integral a => a -> Builder
B.decimal Int
fiPrecedence,
      Builder
" ",
      if Text -> Bool
isTickedOperator Text
operator
        then Builder
"`" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
operator forall a. Semigroup a => a -> a -> a
<> Builder
"`"
        else Text -> Builder
B.fromText Text
operator,
      Builder
"\n"
    ]
  where
    isTickedOperator :: Text -> Bool
isTickedOperator = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char -> Bool
Char.isLetter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

renderSingleModuleReexport ::
  (ModuleName, NonEmpty (Maybe PackageName, ModuleName)) ->
  Builder
renderSingleModuleReexport :: (ModuleName, NonEmpty (Maybe PackageName, ModuleName)) -> Builder
renderSingleModuleReexport (ModuleName
exportingModule, NonEmpty (Maybe PackageName, ModuleName)
exports) =
  forall a. Semigroup a => NonEmpty a -> a
sconcat ((Maybe PackageName, ModuleName) -> Builder
renderSingle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Maybe PackageName, ModuleName)
exports)
  where
    renderSingle :: (Maybe PackageName, ModuleName) -> Builder
renderSingle (Maybe PackageName
mexportedPackage, ModuleName
exportedModule) =
      forall a. Monoid a => [a] -> a
mconcat
        [ Builder
"module ",
          ModuleName -> Builder
renderModuleName ModuleName
exportingModule,
          Builder
" exports ",
          Maybe PackageName -> Builder
renderOptionalPackageName Maybe PackageName
mexportedPackage,
          ModuleName -> Builder
renderModuleName ModuleName
exportedModule,
          Builder
"\n"
        ]
    renderOptionalPackageName :: Maybe PackageName -> Builder
renderOptionalPackageName = \case
      Maybe PackageName
Nothing -> forall a. Monoid a => a
mempty
      Just PackageName
x -> Builder
"\"" forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
B.fromString (PackageName -> [Char]
unPackageName PackageName
x) forall a. Semigroup a => a -> a -> a
<> Builder
"\" "

renderModuleName :: ModuleName -> Builder
renderModuleName :: ModuleName -> Builder
renderModuleName = [Char] -> Builder
B.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [[Char]]
ModuleName.components