{-# 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 (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
      ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map OpName FixityInfo -> [Builder])
-> Map OpName FixityInfo
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OpName, FixityInfo) -> Builder)
-> [(OpName, FixityInfo)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OpName, FixityInfo) -> Builder
renderSingleFixityOverride ([(OpName, FixityInfo)] -> [Builder])
-> (Map OpName FixityInfo -> [(OpName, FixityInfo)])
-> Map OpName FixityInfo
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map OpName FixityInfo -> [(OpName, FixityInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList) Map OpName FixityInfo
fixityOverrides
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
    -> [Builder])
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName, NonEmpty (Maybe PackageName, ModuleName)) -> Builder)
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> [Builder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName, NonEmpty (Maybe PackageName, ModuleName)) -> Builder
renderSingleModuleReexport ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
 -> [Builder])
-> (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
    -> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))])
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
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
fiDirection :: FixityDirection
fiPrecedence :: Int
fiDirection :: FixityInfo -> FixityDirection
fiPrecedence :: FixityInfo -> Int
..}) =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ case FixityDirection
fiDirection of
        FixityDirection
InfixL -> Builder
"infixl"
        FixityDirection
InfixR -> Builder
"infixr"
        FixityDirection
InfixN -> Builder
"infix",
      Builder
" ",
      Int -> Builder
forall a. Integral a => a -> Builder
B.decimal Int
fiPrecedence,
      Builder
" ",
      if Text -> Bool
isTickedOperator Text
operator
        then Builder
"`" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
operator Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"`"
        else Text -> Builder
B.fromText Text
operator,
      Builder
"\n"
    ]
  where
    isTickedOperator :: Text -> Bool
isTickedOperator = Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char -> Bool
Char.isLetter (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, Text) -> Bool)
-> (Text -> Maybe (Char, Text)) -> Text -> Bool
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) =
  NonEmpty Builder -> Builder
forall a. Semigroup a => NonEmpty a -> a
sconcat ((Maybe PackageName, ModuleName) -> Builder
renderSingle ((Maybe PackageName, ModuleName) -> Builder)
-> NonEmpty (Maybe PackageName, ModuleName) -> NonEmpty Builder
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) =
      [Builder] -> Builder
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 -> Builder
forall a. Monoid a => a
mempty
      Just PackageName
x -> Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
B.fromString (PackageName -> [Char]
unPackageName PackageName
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" "

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