{-# language OverloadedStrings #-}
{-# language ViewPatterns #-}
module Language.Elm.Simplification
  ( simplifyDefinition
  , simplifyExpression
  ) where

import Bound
import qualified Bound.Scope as Scope
import Bound.Var (unvar)
import Data.Bifunctor
import Data.Foldable (fold)
import Data.Text (Text)
import qualified Data.Text as Text

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

-- | Perform 'simplifyExpression' on all 'Expression's inside the given
-- 'Definition'.
simplifyDefinition
  :: Definition
  -> Definition
simplifyDefinition :: Definition -> Definition
simplifyDefinition Definition
def =
  case Definition
def of
    Definition.Constant Qualified
name Int
numTypeParams Scope Int Type Void
type_ Expression Void
expr ->
      Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Definition.Constant Qualified
name Int
numTypeParams Scope Int Type Void
type_ (Expression Void -> Definition) -> Expression Void -> Definition
forall a b. (a -> b) -> a -> b
$ Expression Void -> Expression Void
forall v. Expression v -> Expression v
simplifyExpression Expression Void
expr

    Definition.Type {} ->
      Definition
def

    Definition.Alias {} ->
      Definition
def

-- | Run the following simplifications on the given expression:
--
-- * @identity x = x@
-- * @(f >> g) x = g (f x)@
-- * @f >> identity = f@
-- * @identity >> f = f@
-- * @(f << g) x = f (g x)@
-- * @f << identity = f@
-- * @identity << f= f@
-- * @identity <| x = x@
-- * @x |> identity = x@
-- * @x :: [y, z, ...] = [x, y, z, ...]@
-- * Calls to @String.join@, @String.concat@, @List.concat@, and @++@ with
--   known arguments are simplified. For example,
--   @String.join "/" [Config.api, "endpoint"] = Config.api ++ "/endpoint"@
-- * @(\x. e x) = e@
-- * Inline @x@ in @e'@ in
--   @
--   let x = e in e'
--   @
--   if either:
--   - @e@ is freely duplicable, e.g. it's just a variable or a numeric literal.
--   - @x@ occurs zero or one times in @e'@.
-- * @
--   case e of
--     ... prefixBranches
--     pat -> branch
--     ...
--   @
--   is simplified to @let xs = es in branch@ provided that @e@ matches none of
--   @prefixBranches@ and that it matches @pat@.
-- * case-of-case
-- * { n = e, ... }.n = e
--
simplifyExpression
  :: Expression v
  -> Expression v
simplifyExpression :: Expression v -> Expression v
simplifyExpression Expression v
expr =
  Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
expr []

simplifyApplication
  :: Expression v
  -> [Expression v]
  -> Expression v
simplifyApplication :: Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
expr [Expression v]
args =
  case (Expression v
expr, [Expression v]
args) of
    (Expression.Var v
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

    (Expression.Global Qualified
"Basics.identity", Expression v
arg:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
arg [Expression v]
args'

    (Expression.Global Qualified
"Basics.>>", Expression v
f:Expression v
g:Expression v
arg:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
g (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
f Expression v
arg)) [Expression v]
args'

    (Expression.Global Qualified
"Basics.>>", [Expression v
f, Expression.Global Qualified
"Basics.identity"]) ->
      Expression v
f

    (Expression.Global Qualified
"Basics.>>", [Expression.Global Qualified
"Basics.identity", Expression v
f]) ->
      Expression v
f

    (Expression.Global Qualified
"Basics.<<", Expression v
f:Expression v
g:Expression v
arg:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
f (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
g Expression v
arg)) [Expression v]
args'

    (Expression.Global Qualified
"Basics.<<", [Expression v
f, Expression.Global Qualified
"Basics.identity"]) ->
      Expression v
f

    (Expression.Global Qualified
"Basics.<<", [Expression.Global Qualified
"Basics.identity", Expression v
f]) ->
      Expression v
f

    (Expression.Global Qualified
"Basics.<|", Expression.Global Qualified
"Basics.identity":Expression v
arg:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
arg [Expression v]
args'

    (Expression.Global Qualified
"Basics.|>", Expression v
arg:Expression.Global Qualified
"Basics.identity":[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
arg [Expression v]
args'

    (Expression.Global Qualified
"List.::", Expression v
element:Expression.List [Expression v]
elements:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication ([Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List (Expression v
element Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
elements)) [Expression v]
args'

    (Expression.Global Qualified
"String.join", [Expression.String Text
separator, Expression.List [Expression v]
args']) ->
      Text -> [Expression v] -> Expression v
forall v. Text -> [Expression v] -> Expression v
stringJoin Text
separator [Expression v]
args'

    (Expression.Global Qualified
"String.concat", [Expression.List [Expression v]
args']) ->
      [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
stringConcat [Expression v]
args'

    (Expression.Global Qualified
"List.concat", [Expression.List [Expression v]
args']) ->
      [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
listConcat [Expression v]
args'

    (Expression.Global Qualified
"Basics.++", [Expression v
arg1, Expression v
arg2]) ->
      Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
append Expression v
arg1 Expression v
arg2

    (Expression.Global Qualified
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

    (Expression.Proj Field
field, Expression.Record [(Field, Expression v)]
record:[Expression v]
args')
      | Just Expression v
e <- Field -> [(Field, Expression v)] -> Maybe (Expression v)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Field
field [(Field, Expression v)]
record ->
        Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
e [Expression v]
args'

    (Expression.App Expression v
e1 Expression v
e2, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
e1 (Expression v -> Expression v
forall v. Expression v -> Expression v
simplifyExpression Expression v
e2 Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
args)

    (Expression.Let Expression v
e Scope () Expression v
s, [Expression v]
_)
      | Expression v -> Bool
forall v. Expression v -> Bool
freelyDuplicable Expression v
e' ->
        Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication (Expression v -> Scope () Expression v -> Expression v
forall (f :: * -> *) a n. Monad f => f a -> Scope n f a -> f a
instantiate1 Expression v
e' Scope () Expression v
s) [Expression v]
args

      | [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Scope () Expression v -> [()]
forall (f :: * -> *) b a. Foldable f => Scope b f a -> [b]
Scope.bindings Scope () Expression v
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 ->
        Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication (Expression v -> Scope () Expression v -> Expression v
forall (f :: * -> *) a n. Monad f => f a -> Scope n f a -> f a
instantiate1 Expression v
e' Scope () Expression v
s) [Expression v]
args

      | Bool
otherwise ->
        Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
          (Expression v -> Scope () Expression v -> Expression v
forall v. Expression v -> Scope () Expression v -> Expression v
Expression.Let Expression v
e' (Scope () Expression v -> Scope () Expression v
forall b v. Scope b Expression v -> Scope b Expression v
simplifyScope Scope () Expression v
s))
          [Expression v]
args
      where
        e' :: Expression v
e' =
          Expression v -> Expression v
forall v. Expression v -> Expression v
simplifyExpression Expression v
e

    (Expression.Lam Scope () Expression v
s, []) ->
      -- eta reduction (only for single-argument lambdas for now)
      case Expression (Var () v) -> Expression (Var () v)
forall v. Expression v -> Expression v
simplifyExpression (Expression (Var () v) -> Expression (Var () v))
-> Expression (Var () v) -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Scope () Expression v -> Expression (Var () v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope () Expression v
s of
        Expression.App (Expression (Var () v) -> Maybe (Expression v)
forall (f :: * -> *) b a.
Traversable f =>
f (Var b a) -> Maybe (f a)
unusedVar -> Just Expression v
f) (Expression.Var (B ())) ->
          Expression v
f

        Expression (Var () v)
e ->
          Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (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)
e

    (Expression.Lam Scope () Expression v
s, Expression v
arg:[Expression v]
args') ->
      Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication (Expression v -> Scope () Expression v -> Expression v
forall v. Expression v -> Scope () Expression v -> Expression v
Expression.Let Expression v
arg Scope () Expression v
s) [Expression v]
args'

    (Expression.Record [(Field, Expression v)]
fields, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps ([(Field, Expression v)] -> Expression v
forall v. [(Field, Expression v)] -> Expression v
Expression.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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression v -> Expression v
forall v. Expression v -> Expression v
simplifyExpression ((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) [Expression v]
args

    (Expression.Proj Field
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

    (Expression.Case Expression v
scrutinee [(Pattern Int, Scope Int Expression v)]
branches, [Expression v]
_) ->
      let
        scrutinee' :: Expression v
scrutinee' =
          Expression v -> Expression v
forall v. Expression v -> Expression v
simplifyExpression Expression v
scrutinee
      in
        case Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Maybe (Expression v)
forall b v.
Eq b =>
Expression v
-> [(Pattern b, Scope b Expression v)] -> Maybe (Expression v)
findMatchingBranch Expression v
scrutinee' [(Pattern Int, Scope Int Expression v)]
branches of
          Maybe (Expression v)
Nothing ->
            case Expression v
scrutinee' of
              Expression.Case Expression v
innerScrutinee [(Pattern Int, Scope Int Expression v)]
innerBranches ->
                Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication
                  (Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case
                    Expression v
innerScrutinee
                    [ (Pattern Int
pat, Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var Int v)
-> [(Pattern Int, Scope Int Expression (Var Int v))]
-> Expression (Var Int v)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Scope Int Expression v -> Expression (Var Int v)
forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope Int Expression v
branch) ((Scope Int Expression v -> Scope Int Expression (Var Int v))
-> (Pattern Int, Scope Int Expression v)
-> (Pattern Int, Scope Int Expression (Var Int v))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((v -> Var Int v)
-> Scope Int Expression v -> Scope Int Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Var Int v
forall b a. a -> Var b a
F) ((Pattern Int, Scope Int Expression v)
 -> (Pattern Int, Scope Int Expression (Var Int v)))
-> [(Pattern Int, Scope Int Expression v)]
-> [(Pattern Int, Scope Int Expression (Var Int v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pattern Int, Scope Int Expression v)]
branches))
                    | (Pattern Int
pat, Scope Int Expression v
branch) <- [(Pattern Int, Scope Int Expression v)]
innerBranches
                    ]
                  )
                  [Expression v]
args

              Expression v
_ ->
                Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
                  (Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case Expression v
scrutinee' ([(Pattern Int, Scope Int Expression v)] -> Expression v)
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall a b. (a -> b) -> a -> b
$ (Scope Int Expression v -> 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
fmap Scope Int Expression v -> Scope Int Expression v
forall b v. Scope b Expression v -> Scope b Expression v
simplifyScope ((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)
                  [Expression v]
args

          Just Expression v
expr' ->
            Expression v -> [Expression v] -> Expression v
forall v. Expression v -> [Expression v] -> Expression v
simplifyApplication Expression v
expr' [Expression v]
args

    (Expression.List [Expression v]
es, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps ([Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List ([Expression v] -> Expression v) -> [Expression v] -> Expression v
forall a b. (a -> b) -> a -> b
$ Expression v -> Expression v
forall v. Expression v -> Expression v
simplifyExpression (Expression v -> Expression v) -> [Expression v] -> [Expression v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression v]
es) [Expression v]
args

    (Expression.String Text
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

    (Expression.Int Integer
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

    (Expression.Float Double
_, [Expression v]
_) ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
expr [Expression v]
args

simplifyScope
  :: Scope b Expression v
  -> Scope b Expression v
simplifyScope :: Scope b Expression v -> Scope b Expression v
simplifyScope =
  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
. Expression (Var b v) -> Expression (Var b v)
forall v. Expression v -> Expression v
simplifyExpression (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

findMatchingBranch
  :: Eq b
  => Expression v
  -> [(Pattern b, Scope b Expression v)]
  -> Maybe (Expression v)
findMatchingBranch :: Expression v
-> [(Pattern b, Scope b Expression v)] -> Maybe (Expression v)
findMatchingBranch Expression v
scrutinee [(Pattern b, Scope b Expression v)]
branches =
  case [(Pattern b, Scope b Expression v)]
branches of
    [] ->
      Maybe (Expression v)
forall a. Maybe a
Nothing

    (Pattern b
pat, Scope b Expression v
branch):[(Pattern b, Scope b Expression v)]
branches' ->
      case Expression v -> Pattern b -> Match [(b, Expression v)]
forall v b. Expression v -> Pattern b -> Match [(b, Expression v)]
match Expression v
scrutinee Pattern b
pat of
        Match [(b, Expression v)]
Nope ->
          Expression v
-> [(Pattern b, Scope b Expression v)] -> Maybe (Expression v)
forall b v.
Eq b =>
Expression v
-> [(Pattern b, Scope b Expression v)] -> Maybe (Expression v)
findMatchingBranch Expression v
scrutinee [(Pattern b, Scope b Expression v)]
branches'

        Match [(b, Expression v)]
Dunno ->
          Maybe (Expression v)
forall a. Maybe a
Nothing

        Yep [(b, Expression v)]
bindings ->
          Expression v -> Maybe (Expression v)
forall a. a -> Maybe a
Just (Expression v -> Maybe (Expression v))
-> Expression v -> Maybe (Expression v)
forall a b. (a -> b) -> a -> b
$ [(b, Expression v)] -> Scope b Expression v -> Expression v
forall b v.
Eq b =>
[(b, Expression v)] -> Scope b Expression v -> Expression v
Expression.lets [(b, Expression v)]
bindings Scope b Expression v
branch

data Match a
  = Nope
  | Dunno
  | Yep a

instance Semigroup a => Semigroup (Match a) where
  Match a
Nope <> :: Match a -> Match a -> Match a
<> Match a
_ =
    Match a
forall a. Match a
Nope

  Match a
_ <> Match a
Nope =
    Match a
forall a. Match a
Nope

  Match a
Dunno <> Match a
_ =
    Match a
forall a. Match a
Dunno

  Match a
_ <> Match a
Dunno =
    Match a
forall a. Match a
Dunno

  Yep a
a <> Yep a
b =
    a -> Match a
forall a. a -> Match a
Yep (a -> Match a) -> a -> Match a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b

instance Monoid a => Monoid (Match a) where
  mempty :: Match a
mempty =
    a -> Match a
forall a. a -> Match a
Yep a
forall a. Monoid a => a
mempty

match
  :: Expression v
  -> Pattern b
  -> Match [(b, Expression v)]
match :: Expression v -> Pattern b -> Match [(b, Expression v)]
match Expression v
expr Pattern b
pat =
  case (Expression v
expr, Pattern b
pat) of
    (Expression v
_, Pattern.Var b
v) ->
      [(b, Expression v)] -> Match [(b, Expression v)]
forall a. a -> Match a
Yep [(b
v, Expression v
expr)]

    (Expression v
_, Pattern b
Pattern.Wildcard) ->
      Match [(b, Expression v)]
forall a. Monoid a => a
mempty

    (Expression v
_, Pattern.Con Qualified
c2 [Pattern b]
pats) ->
      case Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView Expression v
expr of
        (Expression.Global Qualified
name, [Expression v]
exprs)
          | Qualified
name Qualified -> Qualified -> Bool
forall a. Eq a => a -> a -> Bool
== Qualified
c2 Bool -> Bool -> Bool
&& [Expression v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression v]
exprs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern b]
pats ->
            [Match [(b, Expression v)]] -> Match [(b, Expression v)]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Match [(b, Expression v)]] -> Match [(b, Expression v)])
-> [Match [(b, Expression v)]] -> Match [(b, Expression v)]
forall a b. (a -> b) -> a -> b
$ (Expression v -> Pattern b -> Match [(b, Expression v)])
-> [Expression v] -> [Pattern b] -> [Match [(b, Expression v)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression v -> Pattern b -> Match [(b, Expression v)]
forall v b. Expression v -> Pattern b -> Match [(b, Expression v)]
match [Expression v]
exprs [Pattern b]
pats

          | Qualified -> Bool
Name.isConstructor Qualified
name ->
            Match [(b, Expression v)]
forall a. Match a
Nope

        (Expression v, [Expression v])
_ ->
          Match [(b, Expression v)]
forall a. Match a
Dunno

    (Expression.List [Expression v]
exprs, Pattern.List [Pattern b]
pats)
      | [Expression v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression v]
exprs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern b]
pats ->
        [Match [(b, Expression v)]] -> Match [(b, Expression v)]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Match [(b, Expression v)]] -> Match [(b, Expression v)])
-> [Match [(b, Expression v)]] -> Match [(b, Expression v)]
forall a b. (a -> b) -> a -> b
$ (Expression v -> Pattern b -> Match [(b, Expression v)])
-> [Expression v] -> [Pattern b] -> [Match [(b, Expression v)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expression v -> Pattern b -> Match [(b, Expression v)]
forall v b. Expression v -> Pattern b -> Match [(b, Expression v)]
match [Expression v]
exprs [Pattern b]
pats

    (Expression.List exprs :: [Expression v]
exprs@(Expression v
_:[Expression v]
_), Pattern b
_) ->
      Expression v -> Pattern b -> Match [(b, Expression v)]
forall v b. Expression v -> Pattern b -> Match [(b, Expression v)]
match ((Expression v -> Expression v -> Expression v)
-> Expression v -> [Expression v] -> Expression v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Expression v
e1 Expression v
e2 -> Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"List.::" [Expression v
e1, Expression v
e2]) ([Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List []) [Expression v]
exprs) Pattern b
pat

    (Expression v
_, Pattern.List pats :: [Pattern b]
pats@(Pattern b
_:[Pattern b]
_)) ->
      Expression v -> Pattern b -> Match [(b, Expression v)]
forall v b. Expression v -> Pattern b -> Match [(b, Expression v)]
match Expression v
expr ((Pattern b -> Pattern b -> Pattern b)
-> Pattern b -> [Pattern b] -> Pattern b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Pattern b
p1 Pattern b
p2 -> Qualified -> [Pattern b] -> Pattern b
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"List.::" [Pattern b
p1, Pattern b
p2]) ([Pattern b] -> Pattern b
forall v. [Pattern v] -> Pattern v
Pattern.List []) [Pattern b]
pats)

    (Expression v
_, Pattern.List []) ->
      case Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView Expression v
expr of
        (Expression.Global Qualified
name, [Expression v]
_)
          | Qualified -> Bool
Name.isConstructor Qualified
name ->
            Match [(b, Expression v)]
forall a. Match a
Nope

        (Expression v, [Expression v])
_ ->
            Match [(b, Expression v)]
forall a. Match a
Dunno

    (Expression.String Text
s1, Pattern.String Text
s2)
      | Text
s1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s2 ->
        Match [(b, Expression v)]
forall a. Monoid a => a
mempty

      | Bool
otherwise ->
        Match [(b, Expression v)]
forall a. Match a
Nope

    (Expression v
_, Pattern.String Text
_) ->
      Match [(b, Expression v)]
forall a. Match a
Dunno

    (Expression.Int Integer
i1, Pattern.Int Integer
i2)
      | Integer
i1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i2 ->
        Match [(b, Expression v)]
forall a. Monoid a => a
mempty

      | Bool
otherwise ->
        Match [(b, Expression v)]
forall a. Match a
Nope

    (Expression v
_, Pattern.Int Integer
_) ->
      Match [(b, Expression v)]
forall a. Match a
Dunno

    (Expression.Float Double
f1, Pattern.Float Double
f2)
      | Double
f1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
f2 ->
        Match [(b, Expression v)]
forall a. Monoid a => a
mempty

      | Bool
otherwise ->
        Match [(b, Expression v)]
forall a. Match a
Nope

    (Expression v
_, Pattern.Float Double
_) ->
      Match [(b, Expression v)]
forall a. Match a
Dunno

freelyDuplicable :: Expression v -> Bool
freelyDuplicable :: Expression v -> Bool
freelyDuplicable Expression v
expr =
  case Expression v
expr of
    Expression.Var v
_ ->
      Bool
True

    Expression.Global Qualified
_ ->
      Bool
True

    Expression.App {} ->
      Bool
False

    Expression.Let {} ->
      Bool
False

    Expression.Lam Scope () Expression v
_ ->
      Bool
False

    Expression.Record [] ->
      Bool
True

    Expression.Record [(Field, Expression v)]
_ ->
      Bool
False

    Expression.Proj Field
_ ->
      Bool
True

    Expression.Case {} ->
      Bool
False

    Expression.List [] ->
      Bool
True

    Expression.List [Expression v]
_ ->
      Bool
False

    Expression.String Text
s ->
      Text -> Int
Text.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10

    Expression.Int Integer
_ ->
      Bool
True

    Expression.Float Double
_ ->
      Bool
True

unusedVar :: Traversable f => f (Var b a) -> Maybe (f a)
unusedVar :: f (Var b a) -> Maybe (f a)
unusedVar =
  (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)
traverse ((Var b a -> Maybe a) -> f (Var b a) -> Maybe (f a))
-> (Var b a -> Maybe a) -> f (Var b a) -> Maybe (f a)
forall a b. (a -> b) -> a -> b
$ (b -> Maybe a) -> (a -> Maybe a) -> Var b a -> Maybe a
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

stringJoin :: Text -> [Expression v] -> Expression v
stringJoin :: Text -> [Expression v] -> Expression v
stringJoin Text
separator [Expression v]
args =
  case [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAndJoinAdjacentLiterals [Expression v]
args of
    [] ->
      Text -> Expression v
forall v. Text -> Expression v
Expression.String Text
""

    [Expression v
arg] ->
      Expression v
arg

    [Expression v
arg1, Expression v
arg2] ->
      [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
stringConcat [Expression v
arg1, Text -> Expression v
forall v. Text -> Expression v
Expression.String Text
separator, Expression v
arg2]

    [Expression v]
args' ->
      Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"String.join" [Text -> Expression v
forall v. Text -> Expression v
Expression.String Text
separator, [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
args']
  where
    mergeAndJoinAdjacentLiterals :: [Expression v] -> [Expression v]
mergeAndJoinAdjacentLiterals [Expression v]
args' =
      case [Expression v]
args' of
        [] ->
          []

        Expression.String Text
s1:Expression.String Text
s2:[Expression v]
args'' ->
          [Expression v] -> [Expression v]
mergeAndJoinAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ Text -> Expression v
forall v. Text -> Expression v
Expression.String (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
args''

        Expression v
arg:[Expression v]
args'' ->
          Expression v
argExpression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
:[Expression v] -> [Expression v]
mergeAndJoinAdjacentLiterals [Expression v]
args''

append :: Expression v -> Expression v -> Expression v
append :: Expression v -> Expression v -> Expression v
append Expression v
arg1 Expression v
arg2 =
  case [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v
arg1, Expression v
arg2] of
    [] ->
      Expression v
arg1 Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.++ Expression v
arg2

    [Expression v
arg] ->
      Expression v
arg

    [Expression v
arg1', Expression v
arg2'] ->
      Expression v
arg1' Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.++ Expression v
arg2'

    args :: [Expression v]
args@(Expression v
arg:[Expression v]
args')
      | (Expression v -> Bool) -> [Expression v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Expression v -> Bool
forall v. Expression v -> Bool
isStringLiteral [Expression v]
args ->
        Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"String.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
args

      | (Expression v -> Bool) -> [Expression v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Expression v -> Bool
forall v. Expression v -> Bool
isListLiteral [Expression v]
args ->
        Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"List.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
args

      | Bool
otherwise ->
        (Expression v -> Expression v -> Expression v)
-> Expression v -> [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
(Expression.++) Expression v
arg [Expression v]
args'
  where
    isStringLiteral :: Expression v -> Bool
isStringLiteral Expression v
expr =
      case Expression v
expr of
        Expression.String Text
_ ->
          Bool
True

        Expression v
_ ->
          Bool
False

    isListLiteral :: Expression v -> Bool
isListLiteral Expression v
expr =
      case Expression v
expr of
        Expression.List [Expression v]
_ ->
          Bool
True

        Expression v
_ ->
          Bool
False

unconcat :: Expression v -> [Expression v]
unconcat :: Expression v -> [Expression v]
unconcat Expression v
expr =
  case Expression v -> (Expression v, [Expression v])
forall v. Expression v -> (Expression v, [Expression v])
Expression.appsView Expression v
expr of
    (Expression.Global Qualified
"String.concat", [Expression.List [Expression v]
args]) ->
      Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v]
args

    (Expression.Global Qualified
"List.concat", [Expression.List [Expression v]
args]) ->
      Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v]
args

    (Expression.Global Qualified
"Basics.++", [Expression v
arg1, Expression v
arg2]) ->
      Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v
arg1, Expression v
arg2]

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

mergeAdjacentLiterals :: [Expression v] -> [Expression v]
mergeAdjacentLiterals :: [Expression v] -> [Expression v]
mergeAdjacentLiterals [Expression v]
args =
  case [Expression v]
args of
    [] ->
      []

    Expression.String Text
s1:Expression.String Text
s2:[Expression v]
args' ->
      [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ Text -> Expression v
forall v. Text -> Expression v
Expression.String (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
args'

    Expression.List [Expression v]
l1:Expression.List [Expression v]
l2:[Expression v]
args' ->
      [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List ([Expression v]
l1 [Expression v] -> [Expression v] -> [Expression v]
forall a. Semigroup a => a -> a -> a
<> [Expression v]
l2) Expression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
: [Expression v]
args'

    Expression v
arg:[Expression v]
args' ->
      Expression v
argExpression v -> [Expression v] -> [Expression v]
forall a. a -> [a] -> [a]
:[Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals [Expression v]
args'

stringConcat :: [Expression v] -> Expression v
stringConcat :: [Expression v] -> Expression v
stringConcat [Expression v]
args =
  case [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v]
args of
    [] ->
      Text -> Expression v
forall v. Text -> Expression v
Expression.String Text
""

    [Expression v
arg] ->
      Expression v
arg

    [Expression v
arg1, Expression v
arg2] ->
      Expression v
arg1 Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.++ Expression v
arg2

    [Expression v]
args' ->
      Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"String.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
args'

listConcat :: [Expression v] -> Expression v
listConcat :: [Expression v] -> Expression v
listConcat [Expression v]
args =
  case [Expression v] -> [Expression v]
forall v. [Expression v] -> [Expression v]
mergeAdjacentLiterals ([Expression v] -> [Expression v])
-> [Expression v] -> [Expression v]
forall a b. (a -> b) -> a -> b
$ Expression v -> [Expression v]
forall v. Expression v -> [Expression v]
unconcat (Expression v -> [Expression v])
-> [Expression v] -> [Expression v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expression v]
args of
    [] ->
      [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List []

    [Expression v
arg] ->
      Expression v
arg

    [Expression v
arg1, Expression v
arg2] ->
      Expression v
arg1 Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.++ Expression v
arg2

    [Expression v]
args' ->
      Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"List.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
args'