{- | This module contains some commonly used function for working
with 'Doc's and pretty printing.
-}

module Elm.Print.Common
       ( showDoc
       , wrapParens
       , arrow
       , mkQualified
       , typeWithVarsDoc
       , qualifiedTypeWithVarsDoc
       ) where

import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, concatWith, parens, pretty, surround, (<+>))

import qualified Data.Text as T


-- | Shows pretty-printed document.
showDoc :: Doc ann -> Text
showDoc :: Doc ann -> Text
showDoc = String -> Text
T.pack (String -> Text) -> (Doc ann -> String) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> String
forall a. Show a => a -> String
show

{- | Wraps given document in parens if it contains more than single word.
-}
wrapParens :: Doc ann -> Doc ann
wrapParens :: Doc ann -> Doc ann
wrapParens Doc ann
doc = case Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Doc ann -> Text
forall ann. Doc ann -> Text
showDoc Doc ann
doc of
    []  -> Doc ann
doc
    [Text
_] -> Doc ann
doc
    [Text]
_   -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens Doc ann
doc

-- | Pretty printed arrow (@->@).
arrow :: Doc ann
arrow :: Doc ann
arrow = Doc ann
"->"

{- | Add qualified prefix to the type names or functions:

@
T.MyType

T.showMyType
@

Here we add @T.@ prefix as we only use qualified imports
for @Types as T@ module.
-}
mkQualified :: Text -> Doc ann
mkQualified :: Text -> Doc ann
mkQualified = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (Text -> Text) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"T." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

{- | Creates a 'Doc' of the type with its type variables (if any).
-}
typeWithVarsDoc
    :: Bool  -- ^ Is qualified
    -> Text  -- ^ Type name
    -> [Text] -- ^ List of type variables
    -> Doc ann
typeWithVarsDoc :: Bool -> Text -> [Text] -> Doc ann
typeWithVarsDoc Bool
isQualified Text
typeName = \case
    []   -> Doc ann
forall ann. Doc ann
tName
    [Text]
vars -> Doc ann
forall ann. Doc ann
tName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Text] -> Doc ann
forall ann. [Text] -> Doc ann
typeVarsDoc [Text]
vars
  where
    typeVarsDoc :: [Text] -> Doc ann
    typeVarsDoc :: [Text] -> Doc ann
typeVarsDoc = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
surround Doc ann
" ") ([Doc ann] -> Doc ann)
-> ([Text] -> [Doc ann]) -> [Text] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
    tName :: Doc ann
    tName :: Doc ann
tName =
        if Bool
isQualified
        then Text -> Doc ann
forall ann. Text -> Doc ann
mkQualified Text
typeName
        else Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
typeName

{- | Creates a 'Doc' of the qualified type with its type variables (if any).
-}
qualifiedTypeWithVarsDoc
    :: Text  -- ^ Type name
    -> [Text] -- ^ List of type variables
    -> Doc ann
qualifiedTypeWithVarsDoc :: Text -> [Text] -> Doc ann
qualifiedTypeWithVarsDoc = Bool -> Text -> [Text] -> Doc ann
forall ann. Bool -> Text -> [Text] -> Doc ann
typeWithVarsDoc Bool
True