{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
{-# language ViewPatterns #-}
module Language.Elm.Pretty
  (
  -- * Modules
    modules
  , module_
  -- * Environments
  , Environment(..)
  , emptyEnvironment
  , extend
  -- * Pretty-printing names
  , local
  , field
  , constructor
  , moduleName
  , qualified
  -- * Pretty-printing definitions
  , definition
  -- * Pretty-printing expressions
  , expression
  -- * Pretty-printing pattern
  , pattern
  -- * Pretty-printing types
  , type_
  ) where

import qualified Bound
import qualified Bound.Var as Bound
import Data.Foldable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (sort, intersperse)
import Data.Maybe (isNothing)
import Data.String
import Prettyprinter
import Data.Void

import Language.Elm.Definition (Definition)
import qualified Language.Elm.Definition as Definition
import Language.Elm.Expression (Expression)
import qualified Language.Elm.Expression as Expression
import qualified Language.Elm.Name as Name
import Language.Elm.Pattern (Pattern)
import qualified Language.Elm.Pattern as Pattern
import Language.Elm.Type (Type)
import qualified Language.Elm.Type as Type

-------------------------------------------------------------------------------
-- * Modules

-- | Group the given definitions by their defining module, and generate an Elm
-- module for each group.
modules :: [Definition] -> HashMap Name.Module (Doc ann)
modules :: forall ann. [Definition] -> HashMap Module (Doc ann)
modules [Definition]
defs =
  let
    defsByModule :: HashMap Module [Definition]
defsByModule =
      (HashMap Module [Definition]
 -> HashMap Module [Definition] -> HashMap Module [Definition])
-> HashMap Module [Definition]
-> [HashMap Module [Definition]]
-> HashMap Module [Definition]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        (([Definition] -> [Definition] -> [Definition])
-> HashMap Module [Definition]
-> HashMap Module [Definition]
-> HashMap Module [Definition]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith [Definition] -> [Definition] -> [Definition]
forall a. Semigroup a => a -> a -> a
(<>))
        HashMap Module [Definition]
forall a. Monoid a => a
mempty
        [ Module -> [Definition] -> HashMap Module [Definition]
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Module
m [Definition
def]
        | Definition
def <- [Definition]
defs
        , let
            (Name.Qualified Module
m Text
_) =
              Definition -> Qualified
Definition.name Definition
def
        ]
  in
  (Module -> [Definition] -> Doc ann)
-> HashMap Module [Definition] -> HashMap Module (Doc ann)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey Module -> [Definition] -> Doc ann
forall ann. Module -> [Definition] -> Doc ann
module_ HashMap Module [Definition]
defsByModule

-- | Generate an Elm module containing the given definitions.
module_ :: Name.Module -> [Definition] -> Doc ann
module_ :: forall ann. Module -> [Definition] -> Doc ann
module_ Module
mname [Definition]
defs =
  let
    usedNames :: HashSet Local
usedNames =
      [Local] -> HashSet Local
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
        [ Text -> Local
Name.Local Text
name
        | Name.Qualified Module
_ Text
name <- Definition -> Qualified
Definition.name (Definition -> Qualified) -> [Definition] -> [Qualified]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition]
defs
        ]

    env :: Environment Void
env =
      (Module -> Environment Void
emptyEnvironment Module
mname)
        { freshLocals = filter (not . (`HashSet.member` usedNames)) $ freshLocals (emptyEnvironment mname)
        }

    imports :: [Module]
imports =
      [Module] -> [Module]
forall a. Ord a => [a] -> [a]
sort ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$
      HashSet Module -> [Module]
forall a. HashSet a -> [a]
HashSet.toList (HashSet Module -> [Module]) -> HashSet Module -> [Module]
forall a b. (a -> b) -> a -> b
$
      (HashSet Module -> HashSet Module -> HashSet Module)
-> HashSet Module -> HashSet Module -> HashSet Module
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashSet Module -> HashSet Module -> HashSet Module
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet Module
defaultImports (HashSet Module -> HashSet Module)
-> HashSet Module -> HashSet Module
forall a b. (a -> b) -> a -> b
$
      (Module -> Bool) -> HashSet Module -> HashSet Module
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
mname) (HashSet Module -> HashSet Module)
-> HashSet Module -> HashSet Module
forall a b. (a -> b) -> a -> b
$
      (Qualified -> Module) -> HashSet Qualified -> HashSet Module
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map (\(Name.Qualified Module
m Text
_) -> Module
m) (HashSet Qualified -> HashSet Module)
-> HashSet Qualified -> HashSet Module
forall a b. (a -> b) -> a -> b
$
      (Qualified -> Bool) -> HashSet Qualified -> HashSet Qualified
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (Maybe Local -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Local -> Bool)
-> (Qualified -> Maybe Local) -> Qualified -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified -> Maybe Local
defaultImport) (HashSet Qualified -> HashSet Qualified)
-> HashSet Qualified -> HashSet Qualified
forall a b. (a -> b) -> a -> b
$
      (Definition -> HashSet Qualified)
-> [Definition] -> HashSet Qualified
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Qualified -> HashSet Qualified) -> Definition -> HashSet Qualified
forall m. Monoid m => (Qualified -> m) -> Definition -> m
Definition.foldMapGlobals Qualified -> HashSet Qualified
forall a. Hashable a => a -> HashSet a
HashSet.singleton) [Definition]
defs

    exports :: Doc ann
exports =
      Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      (Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")") (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
      (Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
"( " Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
", ") ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$
      (Definition -> Doc ann) -> [Definition] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> Doc ann
forall {ann}. Definition -> Doc ann
export [Definition]
defs

    export :: Definition -> Doc ann
export = \case
      Definition.Constant (Name.Qualified Module
_ Text
name) Int
_ Scope Int Type Void
_ Expression Void
_ -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name
      Definition.Type (Name.Qualified Module
_ Text
name) Int
_ [(Constructor, [Scope Int Type Void])]
_ -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"(..)"
      Definition.Alias (Name.Qualified Module
_ Text
name) Int
_ Scope Int Type Void
_ -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name

  in
  Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Module -> Doc ann
forall ann. Module -> Doc ann
moduleName Module
mname Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"exposing" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
exports Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
  [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat [Doc ann
"import" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Module -> Doc ann
forall ann. Module -> Doc ann
moduleName Module
import_ Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line | Module
import_ <- [Module]
imports] Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
  [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line) [Environment Void -> Definition -> Doc ann
forall ann. Environment Void -> Definition -> Doc ann
definition Environment Void
env Definition
def | Definition
def <- [Definition]
defs])

defaultImports :: HashSet Name.Module
defaultImports :: HashSet Module
defaultImports =
  [Module] -> HashSet Module
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    [ [Text
"Basics"]
    , [Text
"List"]
    , [Text
"Maybe"]
    , [Text
"Result"]
    , [Text
"String"]
    , [Text
"Char"]
    , [Text
"Tuple"]
    , [Text
"Debug"]
    , [Text
"Platform"]
    , [Text
"Cmd"]
    , [Text
"Sub"]
    ]

-------------------------------------------------------------------------------
-- * Environments

-- | A pretty-printing environment with local variables in @v@.
data Environment v = Environment
  { forall v. Environment v -> v -> Local
locals :: v -> Name.Local
  , forall v. Environment v -> [Local]
freshLocals :: [Name.Local]
  , forall v. Environment v -> Module
currentModule :: Name.Module
  }

emptyEnvironment :: Name.Module -> Environment Void
emptyEnvironment :: Module -> Environment Void
emptyEnvironment Module
m = Environment
  { locals :: Void -> Local
locals = Void -> Local
forall a. Void -> a
absurd
  , freshLocals :: [Local]
freshLocals = (String -> Local
forall a. IsString a => String -> a
fromString (String -> Local) -> (Char -> String) -> Char -> Local
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Local) -> String -> [Local]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a'..Char
'z']) [Local] -> [Local] -> [Local]
forall a. [a] -> [a] -> [a]
++ [String -> Local
forall a. IsString a => String -> a
fromString (String -> Local) -> String -> Local
forall a b. (a -> b) -> a -> b
$ [Char
x] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n | Char
x <- [Char
'a'..Char
'z'], Int
n <- [(Int
0 :: Int)..]]
  , currentModule :: Module
currentModule = Module
m
  }

extend :: Environment v -> (Environment (Bound.Var () v), Name.Local)
extend :: forall v. Environment v -> (Environment (Var () v), Local)
extend Environment v
env =
  case Environment v -> [Local]
forall v. Environment v -> [Local]
freshLocals Environment v
env of
    [] ->
      String -> (Environment (Var () v), Local)
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty no locals"

    Local
fresh:[Local]
freshLocals' ->
      ( Environment v
env
        { locals = Bound.unvar (\() -> Local
fresh) (locals env)
        , freshLocals = freshLocals'
        }
      , Local
fresh
      )

extendPat :: Environment v -> Pattern Int -> Environment (Bound.Var Int v)
extendPat :: forall v. Environment v -> Pattern Int -> Environment (Var Int v)
extendPat Environment v
env Pattern Int
pat =
  let
    occurrencesSet :: HashSet Int
occurrencesSet =
      (Int -> HashSet Int) -> Pattern Int -> HashSet Int
forall m a. Monoid m => (a -> m) -> Pattern a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> HashSet Int
forall a. Hashable a => a -> HashSet a
HashSet.singleton Pattern Int
pat

    occurrences :: [Int]
occurrences =
      HashSet Int -> [Int]
forall a. HashSet a -> [a]
HashSet.toList HashSet Int
occurrencesSet
  in
  Environment v -> [Int] -> Environment (Var Int v)
forall v. Environment v -> [Int] -> Environment (Var Int v)
extendMany Environment v
env [Int]
occurrences

extendMany :: Environment v -> [Int] -> Environment (Bound.Var Int v)
extendMany :: forall v. Environment v -> [Int] -> Environment (Var Int v)
extendMany Environment v
env [Int]
occurrences =
  let
    bindings :: HashMap Int Local
bindings =
      [(Int, Local)] -> HashMap Int Local
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Int, Local)] -> HashMap Int Local)
-> [(Int, Local)] -> HashMap Int Local
forall a b. (a -> b) -> a -> b
$
        [Int] -> [Local] -> [(Int, Local)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
occurrences ([Local] -> [(Int, Local)]) -> [Local] -> [(Int, Local)]
forall a b. (a -> b) -> a -> b
$ Environment v -> [Local]
forall v. Environment v -> [Local]
freshLocals Environment v
env

    freshLocals' :: [Local]
freshLocals' =
      Int -> [Local] -> [Local]
forall a. Int -> [a] -> [a]
drop ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
occurrences) ([Local] -> [Local]) -> [Local] -> [Local]
forall a b. (a -> b) -> a -> b
$ Environment v -> [Local]
forall v. Environment v -> [Local]
freshLocals Environment v
env

    lookupVar :: Int -> Local
lookupVar Int
i =
      case Int -> HashMap Int Local -> Maybe Local
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Int
i HashMap Int Local
bindings of
        Maybe Local
Nothing ->
          String -> Local
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty unbound pattern variable"

        Just Local
v ->
          Local
v
  in
  Environment v
env
    { locals = Bound.unvar lookupVar (locals env)
    , freshLocals = freshLocals'
    }

-------------------------------------------------------------------------------
-- * Pretty-printing names

local :: Name.Local -> Doc ann
local :: forall ann. Local -> Doc ann
local (Name.Local Text
l) =
  Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
l

field :: Name.Field -> Doc ann
field :: forall ann. Field -> Doc ann
field (Name.Field Text
f) =
  Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
f

constructor :: Name.Constructor -> Doc ann
constructor :: forall ann. Constructor -> Doc ann
constructor (Name.Constructor Text
c) =
  Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
c

moduleName :: Name.Module -> Doc ann
moduleName :: forall ann. Module -> Doc ann
moduleName Module
ms =
  [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
dot ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (Text -> Doc ann) -> Module -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
ms)

qualified :: Environment v -> Name.Qualified -> Doc ann
qualified :: forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment v
env name :: Qualified
name@(Name.Qualified Module
ms Text
l) =
  case Qualified -> Maybe Local
defaultImport Qualified
name of
    Maybe Local
Nothing
      | Module
ms Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Environment v -> Module
forall v. Environment v -> Module
currentModule Environment v
env ->
        Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
l

      | Bool
otherwise ->
        case Module
ms of
          [] ->
            Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
l

          Module
_ ->
            Module -> Doc ann
forall ann. Module -> Doc ann
moduleName Module
ms Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dot Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
l

    Just Local
l' ->
      Local -> Doc ann
forall ann. Local -> Doc ann
local Local
l'

defaultImport :: Name.Qualified -> Maybe Name.Local
defaultImport :: Qualified -> Maybe Local
defaultImport Qualified
qname =
  case Qualified
qname of
    Name.Qualified [Text
"Basics"] Text
name ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just (Local -> Maybe Local) -> Local -> Maybe Local
forall a b. (a -> b) -> a -> b
$ Text -> Local
Name.Local Text
name

    Qualified
"Cmd.Cmd" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Cmd"

    Qualified
"List.List" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"List"

    Qualified
"List.::" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"::"

    Qualified
"Maybe.Maybe" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Maybe"

    Qualified
"Maybe.Nothing" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Nothing"

    Qualified
"Maybe.Just" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Just"

    Qualified
"Result.Result" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Result"

    Qualified
"Result.Ok" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Ok"

    Qualified
"Result.Err" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Err"

    Qualified
"String.String" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"String"

    Qualified
"Char.Char" ->
      Local -> Maybe Local
forall a. a -> Maybe a
Just Local
"Char"

    Qualified
_ -> Maybe Local
forall a. Maybe a
Nothing

fixity :: Name.Qualified -> Maybe (Int, Int, Int)
fixity :: Qualified -> Maybe (Int, Int, Int)
fixity Qualified
qname =
  case Qualified
qname of
    Qualified
"Basics.>>" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
9

    Qualified
"Basics.<<" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
9

    Qualified
"Basics.^" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
8

    Qualified
"Basics.*" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
7

    Qualified
"Basics./" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
7

    Qualified
"Basics.//" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
7

    Qualified
"Basics.%" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
7

    Qualified
"Basics.+" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
6

    Qualified
"Basics.-" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
6

    Qualified
"Parser.|=" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
5

    Name.Qualified [Text
"Parser"] Text
"|." ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
6

    Qualified
"Basics.++" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
5

    Qualified
"List.::" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
5

    Qualified
"Basics.==" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics./=" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics.<" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics.>" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics.<=" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics.>=" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
noneAssoc Int
4

    Qualified
"Basics.&&" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
3

    Qualified
"Basics.||" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
3

    Qualified
"Basics.|>" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
leftAssoc Int
0

    Qualified
"Basics.<|" ->
      Int -> Maybe (Int, Int, Int)
forall {c}. Num c => c -> Maybe (c, c, c)
rightAssoc Int
0

    Qualified
"Basics.," ->
      (Int, Int, Int) -> Maybe (Int, Int, Int)
forall a. a -> Maybe a
Just (Int
0, -Int
1, Int
0)

    Qualified
_ ->
      Maybe (Int, Int, Int)
forall a. Maybe a
Nothing

  where
    leftAssoc :: c -> Maybe (c, c, c)
leftAssoc c
n =
      (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
n, c
n, c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)

    rightAssoc :: c -> Maybe (c, c, c)
rightAssoc c
n =
      (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
n, c
n, c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)

    noneAssoc :: c -> Maybe (c, c, c)
noneAssoc c
n =
      (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, c
n, c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)

twoLineOperator :: Name.Qualified -> Bool
twoLineOperator :: Qualified -> Bool
twoLineOperator Qualified
qname =
  case Qualified
qname of
    Qualified
"Basics.>>" ->
      Bool
True

    Qualified
"Basics.<<" ->
      Bool
True

    Qualified
"Basics.|>" ->
      Bool
True

    Qualified
"Basics.<|" ->
      Bool
True

    Qualified
_ ->
      Bool
False

-------------------------------------------------------------------------------
-- * Definitions

definition :: Environment Void -> Definition -> Doc ann
definition :: forall ann. Environment Void -> Definition -> Doc ann
definition Environment Void
env Definition
def =
  case Definition
def of
    Definition.Constant (Name.Qualified Module
_ Text
name) Int
numTypeParams Scope Int Type Void
t Expression Void
e ->
      let
        typeParams :: [Int]
typeParams =
          [Int
0..Int
numTypeParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

        typeEnv :: Environment (Var Int Void)
typeEnv =
          Environment Void -> [Int] -> Environment (Var Int Void)
forall v. Environment v -> [Int] -> Environment (Var Int v)
extendMany Environment Void
env [Int]
typeParams

        ([Local]
names, Doc ann
body) =
          Environment Void -> Expression Void -> ([Local], Doc ann)
forall v ann. Environment v -> Expression v -> ([Local], Doc ann)
lambdas Environment Void
env Expression Void
e
      in
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
4 (Environment (Var Int Void) -> Int -> Type (Var Int Void) -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment (Var Int Void)
typeEnv Int
0 (Type (Var Int Void) -> Doc ann) -> Type (Var Int Void) -> Doc ann
forall a b. (a -> b) -> a -> b
$ Scope Int Type Void -> Type (Var Int Void)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope Scope Int Type Void
t) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
      (case [Local]
names of
        [] ->
          Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"="

        [Local]
_ ->
          Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> [Local] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Local]
names) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=") Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
      Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 Doc ann
forall ann. Doc ann
body

    Definition.Type (Name.Qualified Module
_ Text
name) Int
numParams [(Constructor, [Scope Int Type Void])]
constrs ->
      let
        params :: [Int]
params =
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

        env' :: Environment (Var Int Void)
env' =
          Environment Void -> [Int] -> Environment (Var Int Void)
forall v. Environment v -> [Int] -> Environment (Var Int v)
extendMany Environment Void
env [Int]
params
      in
      Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> (Int -> Local) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment (Var Int Void) -> Var Int Void -> Local
forall v. Environment v -> v -> Local
locals Environment (Var Int Void)
env' (Var Int Void -> Local) -> (Int -> Var Int Void) -> Int -> Local
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Var Int Void
forall b a. b -> Var b a
Bound.B (Int -> Doc ann) -> [Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
params) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
          [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
            (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"| ")
              [Constructor -> Doc ann
forall ann. Constructor -> Doc ann
constructor Constructor
c Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Environment (Var Int Void) -> Int -> Type (Var Int Void) -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment (Var Int Void)
env' (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Type (Var Int Void) -> Doc ann)
-> (Scope Int Type Void -> Type (Var Int Void))
-> Scope Int Type Void
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope Int Type Void -> Type (Var Int Void)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope (Scope Int Type Void -> Doc ann)
-> [Scope Int Type Void] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scope Int Type Void]
ts) | (Constructor
c, [Scope Int Type Void]
ts) <- [(Constructor, [Scope Int Type Void])]
constrs]))

    Definition.Alias (Name.Qualified Module
_ Text
name) Int
numParams Scope Int Type Void
t ->
      let
        params :: [Int]
params =
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

        env' :: Environment (Var Int Void)
env' =
          Environment Void -> [Int] -> Environment (Var Int Void)
forall v. Environment v -> [Int] -> Environment (Var Int v)
extendMany Environment Void
env [Int]
params
      in
      Doc ann
"type alias" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> (Int -> Local) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment (Var Int Void) -> Var Int Void -> Local
forall v. Environment v -> v -> Local
locals Environment (Var Int Void)
env' (Var Int Void -> Local) -> (Int -> Var Int Void) -> Int -> Local
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Var Int Void
forall b a. b -> Var b a
Bound.B (Int -> Doc ann) -> [Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
params) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
      Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Environment (Var Int Void) -> Int -> Type (Var Int Void) -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment (Var Int Void)
env' Int
0 (Type (Var Int Void) -> Doc ann) -> Type (Var Int Void) -> Doc ann
forall a b. (a -> b) -> a -> b
$ Scope Int Type Void -> Type (Var Int Void)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope Scope Int Type Void
t)

-------------------------------------------------------------------------------
-- * Expressions

expression :: Environment v -> Int -> Expression v -> Doc ann
expression :: forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
prec Expression v
expr =
  case Expression v
expr of
    Expression.Var v
var ->
      Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> Local -> Doc ann
forall a b. (a -> b) -> a -> b
$ Environment v -> v -> Local
forall v. Environment v -> v -> Local
locals Environment v
env v
var

    (Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView -> (Expression.Proj Field
f, Expression v
arg:[Expression v]
args)) ->
      (Int -> Expression v -> Doc ann)
-> Int -> Doc ann -> [Expression v] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env) Int
prec (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
projPrec Expression v
arg Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dot Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Field -> Doc ann
forall ann. Field -> Doc ann
field Field
f) [Expression v]
args

    (Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView -> (Expression.Global qname :: Qualified
qname@(Name.Qualified Module
_ Text
name), [Expression v]
args)) ->
      case Qualified -> Maybe (Int, Int, Int)
fixity Qualified
qname of
        Maybe (Int, Int, Int)
Nothing ->
          (Int -> Expression v -> Doc ann)
-> Int -> Doc ann -> [Expression v] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env) Int
prec (Environment v -> Qualified -> Doc ann
forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment v
env Qualified
qname) [Expression v]
args

        Just (Int
leftPrec, Int
opPrec, Int
rightPrec) ->
          case [Expression v]
args of
            [Expression v
arg1, Expression v
arg2] ->
              Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
                Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
leftPrec Expression v
arg1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                (if Qualified -> Bool
twoLineOperator Qualified
qname then Doc ann
forall ann. Doc ann
line else Doc ann
forall ann. Doc ann
space) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
rightPrec Expression v
arg2

            Expression v
arg1:Expression v
arg2:[Expression v]
args' ->
              (Int -> Expression v -> Doc ann)
-> Int -> Expression v -> [Expression v] -> Doc ann
forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env) Int
prec (Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps (Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global Qualified
qname) [Expression v
arg1, Expression v
arg2]) [Expression v]
args'

            [Expression v]
_ ->
              (Int -> Expression v -> Doc ann)
-> Int -> Doc ann -> [Expression v] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env) Int
prec (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name) [Expression v]
args

    (Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView -> (Expression v
fun, args :: [Expression v]
args@(Expression v
_:[Expression v]
_))) ->
      (Int -> Expression v -> Doc ann)
-> Int -> Expression v -> [Expression v] -> Doc ann
forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env) Int
prec Expression v
fun [Expression v]
args

    Expression.Global Qualified
_ ->
      String -> Doc ann
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty expression Global"

    Expression.App {} ->
      String -> Doc ann
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty expression App"

    Expression.Let {} ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
letPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        let
          ([Doc ann]
bindings, Doc ann
body) =
            Environment v -> Expression v -> ([Doc ann], Doc ann)
forall v ann. Environment v -> Expression v -> ([Doc ann], Doc ann)
lets Environment v
env Expression v
expr
        in
        Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"let"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 ([Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line) [Doc ann]
forall {ann}. [Doc ann]
bindings)
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"in"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
body

    Expression.Lam {} ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lamPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        let
          ([Local]
names, Doc ann
body) =
            Environment v -> Expression v -> ([Local], Doc ann)
forall v ann. Environment v -> Expression v -> ([Local], Doc ann)
lambdas Environment v
env Expression v
expr
        in
        Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> [Local] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Local]
names) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
body

    Expression.Record [(Field, Expression v)]
fields ->
      Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
"{ " Doc ann
" }" Doc ann
", "
        [ Field -> Doc ann
forall ann. Field -> Doc ann
field Field
f Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
expr'
        | (Field
f, Expression v
expr') <- [(Field, Expression v)]
fields
        ]

    Expression.Proj Field
f ->
      Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Field -> Doc ann
forall ann. Field -> Doc ann
field Field
f

    Expression.Case Expression v
bool_
      [ (Pattern.Con Qualified
"Basics.True" [], Scope Int Expression v -> Maybe (Expression v)
forall (f :: * -> *) b a.
(Monad f, Traversable f) =>
Scope b f a -> Maybe (f a)
unusedScope -> Just Expression v
true)
      , (Pattern.Con Qualified
"Basics.False" [], Scope Int Expression v -> Maybe (Expression v)
forall (f :: * -> *) b a.
(Monad f, Traversable f) =>
Scope b f a -> Maybe (f a)
unusedScope -> Just Expression v
false)
      ] ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ifPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Doc ann
"if" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
bool_ Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"then" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
          Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
true) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
        Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
        Doc ann
"else" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
          Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
false)

    Expression.Case Expression v
expr' [(Pattern Int, Scope Int Expression v)]
branches ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
casePrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Doc ann
"case" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
expr' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"of" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4
        (
        [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line) ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$
          [ Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env' Int
0 Pattern Int
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Environment (Var Int v) -> Int -> Expression (Var Int v) -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment (Var Int v)
env' Int
0 (Scope Int Expression v -> Expression (Var Int v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope Scope Int Expression v
scope))
          | (Pattern Int
pat, Scope Int Expression v
scope) <- [(Pattern Int, Scope Int Expression v)]
branches
          , let
              env' :: Environment (Var Int v)
env' =
                Environment v -> Pattern Int -> Environment (Var Int v)
forall v. Environment v -> Pattern Int -> Environment (Var Int v)
extendPat Environment v
env Pattern Int
pat
          ]
        )

    Expression.List [Expression v]
exprs ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 (Expression v -> Doc ann) -> [Expression v] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression v]
exprs

    Expression.String Text
s ->
      Doc ann
"\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\""

    Expression.Int Integer
i ->
      Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

    Expression.Float Double
f ->
      Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
f

lets :: Environment v -> Expression v -> ([Doc ann], Doc ann)
lets :: forall v ann. Environment v -> Expression v -> ([Doc ann], Doc ann)
lets Environment v
env Expression v
expr =
  case Expression v
expr of
    Expression.Let Expression v
expr' Scope () Expression v
scope ->
      let
        (Environment (Var () v)
env', Local
name) =
          Environment v -> (Environment (Var () v), Local)
forall v. Environment v -> (Environment (Var () v), Local)
extend Environment v
env

        ([Doc ann]
bindings, Doc ann
body) =
          Environment (Var () v)
-> Expression (Var () v) -> ([Doc ann], Doc ann)
forall v ann. Environment v -> Expression v -> ([Doc ann], Doc ann)
lets Environment (Var () v)
env' (Scope () Expression v -> Expression (Var () v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope Scope () Expression v
scope)

        binding :: Doc ann
binding =
          Local -> Doc ann
forall ann. Local -> Doc ann
local Local
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"="
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
0 Expression v
expr')

      in
      (Doc ann
forall ann. Doc ann
binding Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall {ann}. [Doc ann]
bindings , Doc ann
forall ann. Doc ann
body)

    Expression v
_ ->
      ([], Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
letPrec Expression v
expr)

lambdas :: Environment v -> Expression v -> ([Name.Local], Doc ann)
lambdas :: forall v ann. Environment v -> Expression v -> ([Local], Doc ann)
lambdas Environment v
env Expression v
expr =
  case Expression v
expr of
    Expression.Lam Scope () Expression v
scope ->
      let
        (Environment (Var () v)
env', Local
name) =
          Environment v -> (Environment (Var () v), Local)
forall v. Environment v -> (Environment (Var () v), Local)
extend Environment v
env

        ([Local]
names, Doc ann
body) =
          Environment (Var () v)
-> Expression (Var () v) -> ([Local], Doc ann)
forall v ann. Environment v -> Expression v -> ([Local], Doc ann)
lambdas Environment (Var () v)
env' (Scope () Expression v -> Expression (Var () v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope Scope () Expression v
scope)
      in
      (Local
name Local -> [Local] -> [Local]
forall a. a -> [a] -> [a]
: [Local]
names, Doc ann
forall ann. Doc ann
body)

    Expression v
_ ->
      ([], Environment v -> Int -> Expression v -> Doc ann
forall v ann. Environment v -> Int -> Expression v -> Doc ann
expression Environment v
env Int
lamPrec Expression v
expr)

-------------------------------------------------------------------------------
-- * Patterns

pattern :: Environment (Bound.Var Int v) -> Int -> Pattern Int -> Doc ann
pattern :: forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env Int
prec Pattern Int
pat =
  case Pattern Int
pat of
    Pattern.Var Int
var ->
      Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> Local -> Doc ann
forall a b. (a -> b) -> a -> b
$ Environment (Var Int v) -> Var Int v -> Local
forall v. Environment v -> v -> Local
locals Environment (Var Int v)
env (Int -> Var Int v
forall b a. b -> Var b a
Bound.B Int
var)

    Pattern Int
Pattern.Wildcard ->
      Doc ann
"_"

    Pattern.Con Qualified
con [] ->
      Environment (Var Int v) -> Qualified -> Doc ann
forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment (Var Int v)
env Qualified
con

    Pattern.Con con :: Qualified
con@(Name.Qualified Module
_ Text
name) [Pattern Int]
pats ->
      case Qualified -> Maybe (Int, Int, Int)
fixity Qualified
con of
        Maybe (Int, Int, Int)
Nothing ->
          Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
            Environment (Var Int v) -> Qualified -> Doc ann
forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment (Var Int v)
env Qualified
con Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Pattern Int -> Doc ann) -> [Pattern Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Int]
pats)

        Just (Int
leftPrec, Int
opPrec, Int
rightPrec) ->
          case [Pattern Int]
pats of
            [Pattern Int
pat1, Pattern Int
pat2] ->
              Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
                Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env Int
leftPrec Pattern Int
pat1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                (if Qualified -> Bool
twoLineOperator Qualified
con then Doc ann
forall ann. Doc ann
line else Doc ann
forall ann. Doc ann
space) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env Int
rightPrec Pattern Int
pat2

            Pattern Int
pat1:Pattern Int
pat2:[Pattern Int]
pats' ->
              (Int -> Pattern Int -> Doc ann)
-> Int -> Pattern Int -> [Pattern Int] -> Doc ann
forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps (Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env) Int
prec (Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
con [Pattern Int
pat1, Pattern Int
pat2]) [Pattern Int]
pats'

            [Pattern Int]
_ ->
              Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
                Environment (Var Int v) -> Qualified -> Doc ann
forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment (Var Int v)
env Qualified
con Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Pattern Int -> Doc ann) -> [Pattern Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Int]
pats)

    Pattern.List [Pattern Int]
pats ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
forall v ann.
Environment (Var Int v) -> Int -> Pattern Int -> Doc ann
pattern Environment (Var Int v)
env Int
0 (Pattern Int -> Doc ann) -> [Pattern Int] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Int]
pats

    Pattern.String Text
s ->
      Doc ann
"\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\""

    Pattern.Int Integer
i ->
      Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

    Pattern.Float Double
f ->
      Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
f

-------------------------------------------------------------------------------
-- * Types

type_ :: Environment v -> Int -> Type v -> Doc ann
type_ :: forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env Int
prec Type v
t =
  case Type v
t of
    Type.Var v
var ->
      Local -> Doc ann
forall ann. Local -> Doc ann
local (Local -> Doc ann) -> Local -> Doc ann
forall a b. (a -> b) -> a -> b
$ Environment v -> v -> Local
forall v. Environment v -> v -> Local
locals Environment v
env v
var

    (Type v -> (Type v, [Type v])
forall v. Type v -> (Type v, [Type v])
Type.appsView -> (Type.Global qname :: Qualified
qname@(Name.Qualified Module
_ Text
name), [Type v]
args)) ->
      case Qualified -> Maybe (Int, Int, Int)
fixity Qualified
qname of
        Maybe (Int, Int, Int)
Nothing ->
          (Int -> Type v -> Doc ann) -> Int -> Doc ann -> [Type v] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps (Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env) Int
prec (Environment v -> Qualified -> Doc ann
forall v ann. Environment v -> Qualified -> Doc ann
qualified Environment v
env Qualified
qname) [Type v]
args

        Just (Int
leftPrec, Int
opPrec, Int
rightPrec) ->
          case [Type v]
args of
            [Type v
arg1, Type v
arg2] ->
              Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
opPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
                Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env Int
leftPrec Type v
arg1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                (if Qualified -> Bool
twoLineOperator Qualified
qname then Doc ann
forall ann. Doc ann
line else Doc ann
forall ann. Doc ann
space) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
                Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env Int
rightPrec Type v
arg2

            Type v
arg1:Type v
arg2:[Type v]
args' ->
              (Int -> Type v -> Doc ann) -> Int -> Type v -> [Type v] -> Doc ann
forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps (Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env) Int
prec (Type v -> [Type v] -> Type v
forall v. Type v -> [Type v] -> Type v
Type.apps (Qualified -> Type v
forall v. Qualified -> Type v
Type.Global Qualified
qname) [Type v
arg1, Type v
arg2]) [Type v]
args'

            [Type v]
_ ->
              (Int -> Type v -> Doc ann) -> Int -> Doc ann -> [Type v] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps (Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env) Int
prec (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name) [Type v]
args

    (Type v -> (Type v, [Type v])
forall v. Type v -> (Type v, [Type v])
Type.appsView -> (Type v
fun, args :: [Type v]
args@(Type v
_:[Type v]
_))) ->
      (Int -> Type v -> Doc ann) -> Int -> Type v -> [Type v] -> Doc ann
forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps (Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env) Int
prec Type v
fun [Type v]
args

    Type.Global Qualified
_ ->
      String -> Doc ann
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty type_ Global"

    Type.App {} ->
      String -> Doc ann
forall a. HasCallStack => String -> a
error String
"Language.Elm.Pretty type_ App"

    Type.Fun Type v
t1 Type v
t2 ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
funPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env (Int
funPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Type v
t1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env Int
funPrec Type v
t2

    Type.Record [(Field, Type v)]
fields ->
      Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
"{ " Doc ann
" }" Doc ann
", "
        [ Field -> Doc ann
forall ann. Field -> Doc ann
field Field
f Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Environment v -> Int -> Type v -> Doc ann
forall v ann. Environment v -> Int -> Type v -> Doc ann
type_ Environment v
env Int
0 Type v
type'
        | (Field
f, Type v
type') <- [(Field, Type v)]
fields
        ]

-------------------------------------------------------------------------------
-- Utils

apps :: (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps :: forall a ann. (Int -> a -> Doc ann) -> Int -> a -> [a] -> Doc ann
apps Int -> a -> Doc ann
f Int
prec a
fun [a]
args =
  case [a]
args of
    [] ->
      Int -> a -> Doc ann
f Int
prec a
fun

    [a]
_ ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Int -> a -> Doc ann
f Int
appPrec a
fun Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Int -> a -> Doc ann
f (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Doc ann) -> [a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
args)

atomApps :: (Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps :: forall a ann.
(Int -> a -> Doc ann) -> Int -> Doc ann -> [a] -> Doc ann
atomApps Int -> a -> Doc ann
f Int
prec Doc ann
fun [a]
args =
  case [a]
args of
    [] ->
      Doc ann
fun

    [a]
_ ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parensWhen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Doc ann
fun Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Int -> a -> Doc ann
f (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Doc ann) -> [a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
args)

parensWhen :: Bool -> Doc ann -> Doc ann
parensWhen :: forall ann. Bool -> Doc ann -> Doc ann
parensWhen Bool
b =
  if Bool
b then
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens

  else
    Doc ann -> Doc ann
forall a. a -> a
id

appPrec, letPrec, lamPrec, casePrec, ifPrec, funPrec, projPrec :: Int
appPrec :: Int
appPrec = Int
10
letPrec :: Int
letPrec = Int
0
lamPrec :: Int
lamPrec = Int
0
casePrec :: Int
casePrec = Int
0
ifPrec :: Int
ifPrec = Int
0
funPrec :: Int
funPrec = Int
0
projPrec :: Int
projPrec = Int
11

unusedScope :: (Monad f, Traversable f) => Bound.Scope b f a -> Maybe (f a)
unusedScope :: forall (f :: * -> *) b a.
(Monad f, Traversable f) =>
Scope b f a -> Maybe (f a)
unusedScope =
  (Var b a -> Maybe a) -> f (Var b a) -> Maybe (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((b -> Maybe a) -> (a -> Maybe a) -> Var b a -> Maybe a
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
Bound.unvar (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (f (Var b a) -> Maybe (f a))
-> (Scope b f a -> f (Var b a)) -> Scope b f a -> Maybe (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope b f a -> f (Var b a)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope