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
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)