{-# language DeriveAnyClass #-}
{-# language DeriveFoldable #-}
{-# language DeriveFunctor #-}
{-# language DeriveGeneric #-}
{-# language DeriveTraversable #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TemplateHaskell #-}
{-# language TupleSections #-}
module Language.Elm.Expression where

import Bound
import Bound.Var (unvar)
import Control.Monad
import Data.Bifoldable
import Data.Bifunctor
import Data.Eq.Deriving
import Data.Ord.Deriving
import Data.String
import Data.Text (Text)
import Text.Show.Deriving

import qualified Language.Elm.Name as Name
import Language.Elm.Pattern (Pattern)
import qualified Language.Elm.Pattern as Pattern

data Expression v
  = Var v
  | Global Name.Qualified
  | App (Expression v) (Expression v)
  | Let (Expression v) (Scope () Expression v)
  | Lam (Scope () Expression v)
  | Record [(Name.Field, Expression v)]
  | Proj Name.Field
  | Case (Expression v) [(Pattern Int, Scope Int Expression v)]
  | List [Expression v]
  | String !Text
  | Int !Integer
  | Float !Double
  deriving (a -> Expression b -> Expression a
(a -> b) -> Expression a -> Expression b
(forall a b. (a -> b) -> Expression a -> Expression b)
-> (forall a b. a -> Expression b -> Expression a)
-> Functor Expression
forall a b. a -> Expression b -> Expression a
forall a b. (a -> b) -> Expression a -> Expression b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Expression b -> Expression a
$c<$ :: forall a b. a -> Expression b -> Expression a
fmap :: (a -> b) -> Expression a -> Expression b
$cfmap :: forall a b. (a -> b) -> Expression a -> Expression b
Functor, Expression a -> Bool
(a -> m) -> Expression a -> m
(a -> b -> b) -> b -> Expression a -> b
(forall m. Monoid m => Expression m -> m)
-> (forall m a. Monoid m => (a -> m) -> Expression a -> m)
-> (forall m a. Monoid m => (a -> m) -> Expression a -> m)
-> (forall a b. (a -> b -> b) -> b -> Expression a -> b)
-> (forall a b. (a -> b -> b) -> b -> Expression a -> b)
-> (forall b a. (b -> a -> b) -> b -> Expression a -> b)
-> (forall b a. (b -> a -> b) -> b -> Expression a -> b)
-> (forall a. (a -> a -> a) -> Expression a -> a)
-> (forall a. (a -> a -> a) -> Expression a -> a)
-> (forall a. Expression a -> [a])
-> (forall a. Expression a -> Bool)
-> (forall a. Expression a -> Int)
-> (forall a. Eq a => a -> Expression a -> Bool)
-> (forall a. Ord a => Expression a -> a)
-> (forall a. Ord a => Expression a -> a)
-> (forall a. Num a => Expression a -> a)
-> (forall a. Num a => Expression a -> a)
-> Foldable Expression
forall a. Eq a => a -> Expression a -> Bool
forall a. Num a => Expression a -> a
forall a. Ord a => Expression a -> a
forall m. Monoid m => Expression m -> m
forall a. Expression a -> Bool
forall a. Expression a -> Int
forall a. Expression a -> [a]
forall a. (a -> a -> a) -> Expression a -> a
forall m a. Monoid m => (a -> m) -> Expression a -> m
forall b a. (b -> a -> b) -> b -> Expression a -> b
forall a b. (a -> b -> b) -> b -> Expression a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Expression a -> a
$cproduct :: forall a. Num a => Expression a -> a
sum :: Expression a -> a
$csum :: forall a. Num a => Expression a -> a
minimum :: Expression a -> a
$cminimum :: forall a. Ord a => Expression a -> a
maximum :: Expression a -> a
$cmaximum :: forall a. Ord a => Expression a -> a
elem :: a -> Expression a -> Bool
$celem :: forall a. Eq a => a -> Expression a -> Bool
length :: Expression a -> Int
$clength :: forall a. Expression a -> Int
null :: Expression a -> Bool
$cnull :: forall a. Expression a -> Bool
toList :: Expression a -> [a]
$ctoList :: forall a. Expression a -> [a]
foldl1 :: (a -> a -> a) -> Expression a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Expression a -> a
foldr1 :: (a -> a -> a) -> Expression a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Expression a -> a
foldl' :: (b -> a -> b) -> b -> Expression a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Expression a -> b
foldl :: (b -> a -> b) -> b -> Expression a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Expression a -> b
foldr' :: (a -> b -> b) -> b -> Expression a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Expression a -> b
foldr :: (a -> b -> b) -> b -> Expression a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Expression a -> b
foldMap' :: (a -> m) -> Expression a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Expression a -> m
foldMap :: (a -> m) -> Expression a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Expression a -> m
fold :: Expression m -> m
$cfold :: forall m. Monoid m => Expression m -> m
Foldable, Functor Expression
Foldable Expression
Functor Expression
-> Foldable Expression
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Expression a -> f (Expression b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Expression (f a) -> f (Expression a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Expression a -> m (Expression b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Expression (m a) -> m (Expression a))
-> Traversable Expression
(a -> f b) -> Expression a -> f (Expression b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Expression (m a) -> m (Expression a)
forall (f :: * -> *) a.
Applicative f =>
Expression (f a) -> f (Expression a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Expression a -> m (Expression b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Expression a -> f (Expression b)
sequence :: Expression (m a) -> m (Expression a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Expression (m a) -> m (Expression a)
mapM :: (a -> m b) -> Expression a -> m (Expression b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Expression a -> m (Expression b)
sequenceA :: Expression (f a) -> f (Expression a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Expression (f a) -> f (Expression a)
traverse :: (a -> f b) -> Expression a -> f (Expression b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Expression a -> f (Expression b)
$cp2Traversable :: Foldable Expression
$cp1Traversable :: Functor Expression
Traversable)

instance Applicative Expression where
  pure :: a -> Expression a
pure = a -> Expression a
forall a. a -> Expression a
Var
  <*> :: Expression (a -> b) -> Expression a -> Expression b
(<*>) = Expression (a -> b) -> Expression a -> Expression b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Expression where
  Expression a
expression >>= :: Expression a -> (a -> Expression b) -> Expression b
>>= a -> Expression b
f =
    case Expression a
expression of
      Var a
v ->
        a -> Expression b
f a
v

      Global Qualified
g ->
        Qualified -> Expression b
forall v. Qualified -> Expression v
Global Qualified
g
  
      App Expression a
g Expression a
x ->
        Expression b -> Expression b -> Expression b
forall v. Expression v -> Expression v -> Expression v
App (Expression a
g Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f) (Expression a
x Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f)

      Let Expression a
e Scope () Expression a
s ->
        Expression b -> Scope () Expression b -> Expression b
forall v. Expression v -> Scope () Expression v -> Expression v
Let (Expression a
e Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f) (Scope () Expression a
s Scope () Expression a
-> (a -> Expression b) -> Scope () Expression b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
t f a -> (a -> f c) -> t f c
>>>= a -> Expression b
f)

      Lam Scope () Expression a
e -> 
        Scope () Expression b -> Expression b
forall v. Scope () Expression v -> Expression v
Lam (Scope () Expression a
e Scope () Expression a
-> (a -> Expression b) -> Scope () Expression b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
t f a -> (a -> f c) -> t f c
>>>= a -> Expression b
f)

      Record [(Field, Expression a)]
fields ->
        [(Field, Expression b)] -> Expression b
forall v. [(Field, Expression v)] -> Expression v
Record (((Field, Expression a) -> (Field, Expression b))
-> [(Field, Expression a)] -> [(Field, Expression b)]
forall a b. (a -> b) -> [a] -> [b]
map ((Expression a -> Expression b)
-> (Field, Expression a) -> (Field, Expression b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f)) [(Field, Expression a)]
fields)
  
      Proj Field
fieldName ->
        Field -> Expression b
forall v. Field -> Expression v
Proj Field
fieldName

      Case Expression a
e [(Pattern Int, Scope Int Expression a)]
patterns ->
        Expression b
-> [(Pattern Int, Scope Int Expression b)] -> Expression b
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Case (Expression a
e Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f) (((Pattern Int, Scope Int Expression a)
 -> (Pattern Int, Scope Int Expression b))
-> [(Pattern Int, Scope Int Expression a)]
-> [(Pattern Int, Scope Int Expression b)]
forall a b. (a -> b) -> [a] -> [b]
map ((Scope Int Expression a -> Scope Int Expression b)
-> (Pattern Int, Scope Int Expression a)
-> (Pattern Int, Scope Int Expression b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Scope Int Expression a
-> (a -> Expression b) -> Scope Int Expression b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
t f a -> (a -> f c) -> t f c
>>>= a -> Expression b
f)) [(Pattern Int, Scope Int Expression a)]
patterns)
  
      List [Expression a]
es -> 
        [Expression b] -> Expression b
forall v. [Expression v] -> Expression v
List ((Expression a -> Expression b) -> [Expression a] -> [Expression b]
forall a b. (a -> b) -> [a] -> [b]
map (Expression a -> (a -> Expression b) -> Expression b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expression b
f) [Expression a]
es)

      String Text
text ->
        Text -> Expression b
forall v. Text -> Expression v
String Text
text

      Int Integer
integer -> 
        Integer -> Expression b
forall v. Integer -> Expression v
Int Integer
integer

      Float Double
double -> 
        Double -> Expression b
forall v. Double -> Expression v
Float Double
double


bind :: forall v v'. (Name.Qualified -> Expression v') -> (v -> Expression v') -> Expression v -> Expression v'
bind :: (Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var Expression v
expression =
  case Expression v
expression of
    Var v
v ->
      v -> Expression v'
var v
v

    Global Qualified
g ->
      Qualified -> Expression v'
global Qualified
g

    App Expression v
t1 Expression v
t2 ->
      Expression v' -> Expression v' -> Expression v'
forall v. Expression v -> Expression v -> Expression v
App ((Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var Expression v
t1) ((Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var Expression v
t2)

    Let Expression v
e Scope () Expression v
s ->
      Expression v' -> Scope () Expression v' -> Expression v'
forall v. Expression v -> Scope () Expression v -> Expression v
Let ((Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var Expression v
e) (Scope () Expression v -> Scope () Expression v'
forall b. Scope b Expression v -> Scope b Expression v'
bindScope Scope () Expression v
s)

    Lam Scope () Expression v
s ->
      Scope () Expression v' -> Expression v'
forall v. Scope () Expression v -> Expression v
Lam (Scope () Expression v -> Scope () Expression v'
forall b. Scope b Expression v -> Scope b Expression v'
bindScope Scope () Expression v
s)

    Record [(Field, Expression v)]
fields ->
      [(Field, Expression v')] -> Expression v'
forall v. [(Field, Expression v)] -> Expression v
Record ([(Field, Expression v')] -> Expression v')
-> [(Field, Expression v')] -> Expression v'
forall a b. (a -> b) -> a -> b
$ (Expression v -> Expression v')
-> (Field, Expression v) -> (Field, Expression v')
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var) ((Field, Expression v) -> (Field, Expression v'))
-> [(Field, Expression v)] -> [(Field, Expression v')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Field, Expression v)]
fields

    Proj Field
fname ->
      Field -> Expression v'
forall v. Field -> Expression v
Proj Field
fname

    Case Expression v
scrutinee [(Pattern Int, Scope Int Expression v)]
branches ->
      Expression v'
-> [(Pattern Int, Scope Int Expression v')] -> Expression v'
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Case
        ((Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var Expression v
scrutinee)
        ((Scope Int Expression v -> Scope Int Expression v')
-> (Pattern Int, Scope Int Expression v)
-> (Pattern Int, Scope Int Expression v')
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Scope Int Expression v -> Scope Int Expression v'
forall b. Scope b Expression v -> Scope b Expression v'
bindScope ((Pattern Int, Scope Int Expression v)
 -> (Pattern Int, Scope Int Expression v'))
-> [(Pattern Int, Scope Int Expression v)]
-> [(Pattern Int, Scope Int Expression v')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pattern Int, Scope Int Expression v)]
branches)

    List [Expression v]
es ->
      [Expression v'] -> Expression v'
forall v. [Expression v] -> Expression v
List ([Expression v'] -> Expression v')
-> [Expression v'] -> Expression v'
forall a b. (a -> b) -> a -> b
$ (Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression v'
global v -> Expression v'
var (Expression v -> Expression v')
-> [Expression v] -> [Expression v']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression v]
es

    String Text
s ->
      Text -> Expression v'
forall v. Text -> Expression v
String Text
s

    Int Integer
i ->
      Integer -> Expression v'
forall v. Integer -> Expression v
Int Integer
i

    Float Double
f ->
      Double -> Expression v'
forall v. Double -> Expression v
Float Double
f
  where
    bindScope :: Scope b Expression v -> Scope b Expression v'
    bindScope :: Scope b Expression v -> Scope b Expression v'
bindScope =
      Expression (Var b v') -> Scope b Expression v'
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var b v') -> Scope b Expression v')
-> (Scope b Expression v -> Expression (Var b v'))
-> Scope b Expression v
-> Scope b Expression v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (Qualified -> Expression (Var b v'))
-> (Var b v -> Expression (Var b v'))
-> Expression (Var b v)
-> Expression (Var b v')
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind ((v' -> Var b v') -> Expression v' -> Expression (Var b v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v' -> Var b v'
forall b a. a -> Var b a
F (Expression v' -> Expression (Var b v'))
-> (Qualified -> Expression v')
-> Qualified
-> Expression (Var b v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified -> Expression v'
global) ((b -> Expression (Var b v'))
-> (v -> Expression (Var b v')) -> Var b v -> Expression (Var b v')
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar (Var b v' -> Expression (Var b v')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var b v' -> Expression (Var b v'))
-> (b -> Var b v') -> b -> Expression (Var b v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b v'
forall b a. b -> Var b a
B) ((v' -> Var b v') -> Expression v' -> Expression (Var b v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v' -> Var b v'
forall b a. a -> Var b a
F (Expression v' -> Expression (Var b v'))
-> (v -> Expression v') -> v -> Expression (Var b v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Expression v'
var)) (Expression (Var b v) -> Expression (Var b v'))
-> (Scope b Expression v -> Expression (Var b v))
-> Scope b Expression v
-> Expression (Var b v')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Scope b Expression v -> Expression (Var b v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope

deriveEq1 ''Expression
deriveOrd1 ''Expression
deriveShow1 ''Expression

deriving instance Eq v => Eq (Expression v)
deriving instance Ord v => Ord (Expression v)
deriving instance Show v => Show (Expression v)

instance IsString (Expression v) where
  fromString :: String -> Expression v
fromString = Qualified -> Expression v
forall v. Qualified -> Expression v
Global (Qualified -> Expression v)
-> (String -> Qualified) -> String -> Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Qualified
forall a. IsString a => String -> a
fromString

apps :: Foldable f => Expression v -> f (Expression v) -> Expression v
apps :: Expression v -> f (Expression v) -> Expression v
apps = (Expression v -> Expression v -> Expression v)
-> Expression v -> f (Expression v) -> Expression v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
App

appsView :: Expression v -> (Expression v, [Expression v])
appsView :: Expression v -> (Expression v, [Expression v])
appsView = [Expression v] -> Expression v -> (Expression v, [Expression v])
forall v.
[Expression v] -> Expression v -> (Expression v, [Expression v])
go [Expression v]
forall a. Monoid a => a
mempty
  where
    go :: [Expression v] -> Expression v -> (Expression v, [Expression v])
go [Expression v]
args Expression v
expr =
      case Expression v
expr of
        App Expression v
e1 Expression v
e2 ->
          [Expression v] -> Expression v -> (Expression v, [Expression v])
go (Expression v
e2 Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
args) Expression v
e1

        Expression v
_ ->
          (Expression v
expr, [Expression v]
args)

if_ :: Expression v -> Expression v -> Expression v -> Expression v
if_ :: Expression v -> Expression v -> Expression v -> Expression v
if_ Expression v
bool_ Expression v
true Expression v
false =
  Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Case Expression v
bool_
    [ (Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Basics.True" [], Expression (Var Int (Expression v)) -> Scope Int Expression v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (Expression (Var Int (Expression v)) -> Scope Int Expression v)
-> Expression (Var Int (Expression v)) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$ Var Int (Expression v) -> Expression (Var Int (Expression v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Expression v) -> Expression (Var Int (Expression v)))
-> Var Int (Expression v) -> Expression (Var Int (Expression v))
forall a b. (a -> b) -> a -> b
$ Expression v -> Var Int (Expression v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression v
true)
    , (Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Basics.False" [], Expression (Var Int (Expression v)) -> Scope Int Expression v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (Expression (Var Int (Expression v)) -> Scope Int Expression v)
-> Expression (Var Int (Expression v)) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$ Var Int (Expression v) -> Expression (Var Int (Expression v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Expression v) -> Expression (Var Int (Expression v)))
-> Var Int (Expression v) -> Expression (Var Int (Expression v))
forall a b. (a -> b) -> a -> b
$ Expression v -> Var Int (Expression v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression v
false)
    ]

(|>) :: Expression v -> Expression v -> Expression v
|> :: Expression v -> Expression v -> Expression v
(|>) Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.|>" [Expression v
e1, Expression v
e2]

(<|) :: Expression v -> Expression v -> Expression v
<| :: Expression v -> Expression v -> Expression v
(<|) Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.<|" [Expression v
e1, Expression v
e2]

(<<) :: Expression v -> Expression v -> Expression v
<< :: Expression v -> Expression v -> Expression v
(<<) Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.<<" [Expression v
e1, Expression v
e2]

(>>) :: Expression v -> Expression v -> Expression v
>> :: Expression v -> Expression v -> Expression v
(>>) Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.>>" [Expression v
e1, Expression v
e2]

(++) :: Expression v -> Expression v -> Expression v
++ :: Expression v -> Expression v -> Expression v
(++) Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.++" [Expression v
e1, Expression v
e2]

tuple :: Expression v -> Expression v -> Expression v
tuple :: Expression v -> Expression v -> Expression v
tuple Expression v
e1 Expression v
e2 = Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
apps Expression v
"Basics.," [Expression v
e1, Expression v
e2]

lets :: Eq b => [(b, Expression v)] -> Scope b Expression v -> Expression v
lets :: [(b, Expression v)] -> Scope b Expression v -> Expression v
lets =
  (b -> v)
-> (v -> v)
-> [(b, Expression v)]
-> Scope b Expression v
-> Expression v
forall b v' v.
Eq b =>
(b -> v')
-> (v -> v')
-> [(b, Expression v)]
-> Scope b Expression v
-> Expression v'
go (String -> b -> v
forall a. HasCallStack => String -> a
error String
"Language.Elm.Expression.lets unbound var") v -> v
forall a. a -> a
id
  where
    go :: Eq b => (b -> v') -> (v -> v') -> [(b, Expression v)] -> Scope b Expression v -> Expression v'
    go :: (b -> v')
-> (v -> v')
-> [(b, Expression v)]
-> Scope b Expression v
-> Expression v'
go b -> v'
boundVar v -> v'
freeVar [(b, Expression v)]
bindings Scope b Expression v
scope =
      case [(b, Expression v)]
bindings of
        [] ->
          (b -> v') -> (v -> v') -> Var b v -> v'
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar b -> v'
boundVar v -> v'
freeVar (Var b v -> v') -> Expression (Var b v) -> Expression v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scope b Expression v -> Expression (Var b v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b Expression v
scope

        (b
v, Expression v
e):[(b, Expression v)]
bindings' ->
          Expression v' -> Scope () Expression v' -> Expression v'
forall v. Expression v -> Scope () Expression v -> Expression v
Let (v -> v'
freeVar (v -> v') -> Expression v -> Expression v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression v
e) (Scope () Expression v' -> Expression v')
-> Scope () Expression v' -> Expression v'
forall a b. (a -> b) -> a -> b
$
            Expression (Var () v') -> Scope () Expression v'
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var () v') -> Scope () Expression v')
-> Expression (Var () v') -> Scope () Expression v'
forall a b. (a -> b) -> a -> b
$
            (b -> Var () v')
-> (v -> Var () v')
-> [(b, Expression v)]
-> Scope b Expression v
-> Expression (Var () v')
forall b v' v.
Eq b =>
(b -> v')
-> (v -> v')
-> [(b, Expression v)]
-> Scope b Expression v
-> Expression v'
go
              (\b
b -> if b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
v then () -> Var () v'
forall b a. b -> Var b a
B () else v' -> Var () v'
forall b a. a -> Var b a
F (v' -> Var () v') -> v' -> Var () v'
forall a b. (a -> b) -> a -> b
$ b -> v'
boundVar b
b)
              (v' -> Var () v'
forall b a. a -> Var b a
F (v' -> Var () v') -> (v -> v') -> v -> Var () v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> v'
freeVar)
              [(b, Expression v)]
bindings'
              Scope b Expression v
scope

foldMapGlobals
  :: Monoid m
  => (Name.Qualified -> m)
  -> Expression v
  -> m
foldMapGlobals :: (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f Expression v
expr =
  case Expression v
expr of
    Var v
_ ->
      m
forall a. Monoid a => a
mempty

    Global Qualified
qname ->
      Qualified -> m
f Qualified
qname

    App Expression v
e1 Expression v
e2 ->
      (Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f Expression v
e1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f Expression v
e2

    Let Expression v
e Scope () Expression v
s ->
      (Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f Expression v
e m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Qualified -> m) -> Expression (Var () v) -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f (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
s)

    Lam Scope () Expression v
s ->
      (Qualified -> m) -> Expression (Var () v) -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f (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
s)

    Record [(Field, Expression v)]
fields ->
      ((Field, Expression v) -> m) -> [(Field, Expression v)] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Expression v -> m) -> (Field, Expression v) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f)) [(Field, Expression v)]
fields

    Proj Field
_ ->
      m
forall a. Monoid a => a
mempty

    Case Expression v
e [(Pattern Int, Scope Int Expression v)]
branches ->
      (Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f Expression v
e m -> m -> m
forall a. Semigroup a => a -> a -> a
<>
      ((Pattern Int, Scope Int Expression v) -> m)
-> [(Pattern Int, Scope Int Expression v)] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ((Pattern Int -> m)
-> (Scope Int Expression v -> m)
-> (Pattern Int, Scope Int Expression v)
-> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((Qualified -> m) -> Pattern Int -> m
forall m v. Monoid m => (Qualified -> m) -> Pattern v -> m
Pattern.foldMapGlobals Qualified -> m
f) ((Qualified -> m) -> Expression (Var Int v) -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f (Expression (Var Int v) -> m)
-> (Scope Int Expression v -> Expression (Var Int v))
-> Scope Int Expression v
-> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Scope Int Expression v -> Expression (Var Int v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
Bound.fromScope))
        [(Pattern Int, Scope Int Expression v)]
branches

    List [Expression v]
es ->
      (Expression v -> m) -> [Expression v] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Qualified -> m) -> Expression v -> m
forall m v. Monoid m => (Qualified -> m) -> Expression v -> m
foldMapGlobals Qualified -> m
f) [Expression v]
es

    String Text
_ ->
      m
forall a. Monoid a => a
mempty

    Int Integer
_ ->
      m
forall a. Monoid a => a
mempty

    Float Double
_ ->
      m
forall a. Monoid a => a
mempty