module Language.Dickinson.Check.Exhaustive ( checkExhaustive
                                           ) where

import           Control.Applicative                ((<|>))
import           Data.Foldable                      (toList)
import           Data.Foldable.Ext
import           Data.List                          (inits)
import           Data.Maybe                         (mapMaybe)
import           Language.Dickinson.Error
import           Language.Dickinson.Pattern.Useless
import           Language.Dickinson.Type

-- | Check that there are no useless pattern clauses and check that the pattern
-- matches are exhaustive
checkExhaustive :: [Declaration a] -> Maybe (DickinsonWarning a)
checkExhaustive :: forall a. [Declaration a] -> Maybe (DickinsonWarning a)
checkExhaustive = forall a. [Declaration a] -> Maybe (DickinsonWarning a)
checkDeclsM

checkDeclsM :: [Declaration a] -> Maybe (DickinsonWarning a)
checkDeclsM :: forall a. [Declaration a] -> Maybe (DickinsonWarning a)
checkDeclsM [Declaration a]
ds =
    let pEnv :: PatternEnv
pEnv = forall a. PatternM a -> PatternEnv
runPatternM forall a b. (a -> b) -> a -> b
$ forall a. [Declaration a] -> PatternM ()
patternEnvDecls [Declaration a]
ds in
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Declaration a -> Maybe (DickinsonWarning a)
checkDecl PatternEnv
pEnv) [Declaration a]
ds

checkDecl :: PatternEnv -> Declaration a -> Maybe (DickinsonWarning a)
checkDecl :: forall a. PatternEnv -> Declaration a -> Maybe (DickinsonWarning a)
checkDecl PatternEnv
_ TyDecl{}         = forall a. Maybe a
Nothing
checkDecl PatternEnv
env (Define a
_ Name a
_ Expression a
e) = forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e

isExhaustiveErr :: PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
isExhaustiveErr :: forall a.
PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
isExhaustiveErr PatternEnv
env [Pattern a]
ps a
loc =
    if forall a. PatternEnv -> [Pattern a] -> Bool
isExhaustive PatternEnv
env [Pattern a]
ps
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> DickinsonWarning a
InexhaustiveMatch a
loc

uselessErr :: PatternEnv -> [Pattern a] -> Pattern a -> Maybe (DickinsonWarning a)
uselessErr :: forall a.
PatternEnv
-> [Pattern a] -> Pattern a -> Maybe (DickinsonWarning a)
uselessErr PatternEnv
env [Pattern a]
ps Pattern a
p = {-# SCC "uselessErr" #-}
    if forall a. PatternEnv -> [Pattern a] -> Pattern a -> Bool
useful PatternEnv
env [Pattern a]
ps Pattern a
p
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Pattern a -> DickinsonWarning a
UselessPattern (forall a. Pattern a -> a
patAnn Pattern a
p) Pattern a
p

foliate :: [a] -> [([a], a)]
foliate :: forall a. [a] -> [([a], a)]
foliate = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. [b] -> Maybe ([b], b)
split forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
inits
    where split :: [b] -> Maybe ([b], b)
split []  = forall a. Maybe a
Nothing
          split [b
_] = forall a. Maybe a
Nothing
          split [b]
xs  = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
init [b]
xs, forall a. [a] -> a
last [b]
xs)

checkMatch :: PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
checkMatch :: forall a.
PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
checkMatch PatternEnv
env [Pattern a]
ps a
loc = {-# SCC "checkMatch" #-}
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a.
PatternEnv
-> [Pattern a] -> Pattern a -> Maybe (DickinsonWarning a)
uselessErr PatternEnv
env)) ({-# SCC "foliate" #-} forall a. [a] -> [([a], a)]
foliate [Pattern a]
ps)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
isExhaustiveErr PatternEnv
env [Pattern a]
ps a
loc

checkExpr :: PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr :: forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
_ Var{}                = forall a. Maybe a
Nothing
checkExpr PatternEnv
_ Literal{}            = forall a. Maybe a
Nothing
checkExpr PatternEnv
_ StrChunk{}           = forall a. Maybe a
Nothing
checkExpr PatternEnv
_ Constructor{}        = forall a. Maybe a
Nothing
checkExpr PatternEnv
_ BuiltinFn{}          = forall a. Maybe a
Nothing
checkExpr PatternEnv
_ Random{}             = forall a. Maybe a
Nothing
checkExpr PatternEnv
env (Flatten a
_ Expression a
e)      = forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
checkExpr PatternEnv
env (Annot a
_ Expression a
e DickinsonTy a
_)      = forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
checkExpr PatternEnv
env (Lambda a
_ Name a
_ DickinsonTy a
_ Expression a
e)   = forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
checkExpr PatternEnv
env (Choice a
_ NonEmpty (Double, Expression a)
brs)     = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Double, Expression a)
brs)
checkExpr PatternEnv
env (Let a
_ NonEmpty (Name a, Expression a)
brs Expression a
e)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
brs) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
checkExpr PatternEnv
env (Bind a
_ NonEmpty (Name a, Expression a)
brs Expression a
e)     = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
brs) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
checkExpr PatternEnv
env (Interp a
_ [Expression a]
es)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) [Expression a]
es
checkExpr PatternEnv
env (MultiInterp a
_ [Expression a]
es) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) [Expression a]
es
checkExpr PatternEnv
env (Apply a
_ Expression a
e Expression a
e')     = forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e'
checkExpr PatternEnv
env (Concat a
_ [Expression a]
es)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) [Expression a]
es
checkExpr PatternEnv
env (Tuple a
_ NonEmpty (Expression a)
es)       = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) NonEmpty (Expression a)
es
checkExpr PatternEnv
env (Match a
l Expression a
e NonEmpty (Pattern a, Expression a)
brs)    =
    forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env Expression a
e
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
checkMatch PatternEnv
env (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Pattern a, Expression a)
brs)) a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
checkExpr PatternEnv
env) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Pattern a, Expression a)
brs)