module Language.Dickinson.Check.Pattern ( traversePattern
                                        , checkPatternDecl
                                        ) where

import           Control.Applicative      ((<|>))
import           Data.Foldable            (toList)
import           Data.Foldable.Ext        (foldMapAlternative)
import           Data.List                (group, sort)
import           Data.Maybe               (mapMaybe)
import           Language.Dickinson.Error
import           Language.Dickinson.Name
import           Language.Dickinson.Type

traversePattern :: Pattern a -> [Name a]
traversePattern :: forall a. Pattern a -> [Name a]
traversePattern (PatternVar a
_ Name a
n)    = [Name a
n]
traversePattern (PatternTuple a
_ NonEmpty (Pattern a)
ps) = forall a. Pattern a -> [Name a]
traversePattern forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Pattern a)
ps
traversePattern Wildcard{}          = []
traversePattern PatternCons{}       = []
traversePattern (OrPattern a
_ NonEmpty (Pattern a)
ps)    = forall a. Pattern a -> [Name a]
traversePattern forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Pattern a)
ps

checkPattern :: Pattern a -> Maybe (DickinsonError a)
checkPattern :: forall a. Pattern a -> Maybe (DickinsonError a)
checkPattern Pattern a
p = forall a. Pattern a -> Maybe (DickinsonError a)
checkCoherent Pattern a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Pattern a -> Maybe (DickinsonError a)
checkNames Pattern a
p

checkNames :: Pattern a -> Maybe (DickinsonError a)
checkNames :: forall a. Pattern a -> Maybe (DickinsonError a)
checkNames Pattern a
p = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative [Name a] -> Maybe (DickinsonError a)
announce (forall a. Eq a => [a] -> [[a]]
group forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort (forall a. Pattern a -> [Name a]
traversePattern Pattern a
p))
    where announce :: [Name a] -> Maybe (DickinsonError a)
announce (Name a
_:Name a
y:[Name a]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Name a -> Pattern a -> DickinsonError a
MultiBind (forall a. Name a -> a
loc Name a
y) Name a
y Pattern a
p
          announce [Name a]
_       = forall a. Maybe a
Nothing

noVar :: Pattern a -> Bool
noVar :: forall a. Pattern a -> Bool
noVar PatternVar{}        = Bool
False
noVar (PatternTuple a
_ NonEmpty (Pattern a)
ps) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Pattern a -> Bool
noVar NonEmpty (Pattern a)
ps
noVar Wildcard{}          = Bool
True
noVar PatternCons{}       = Bool
True
noVar (OrPattern a
_ NonEmpty (Pattern a)
ps)    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Pattern a -> Bool
noVar NonEmpty (Pattern a)
ps

-- in theory I guess if an or-pattern bound a variable in all its leaves (and
-- all were the same type) I guess it would work
--
-- but this throws out any or-patterns containing wildcards or variables
checkCoherent :: Pattern a -> Maybe (DickinsonError a)
checkCoherent :: forall a. Pattern a -> Maybe (DickinsonError a)
checkCoherent PatternVar{}                  = forall a. Maybe a
Nothing
checkCoherent (PatternTuple a
_ NonEmpty (Pattern a)
ps)           = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. Pattern a -> Maybe (DickinsonError a)
checkCoherent NonEmpty (Pattern a)
ps
checkCoherent Wildcard{}                    = forall a. Maybe a
Nothing
checkCoherent PatternCons{}                 = forall a. Maybe a
Nothing
checkCoherent o :: Pattern a
o@(OrPattern a
l NonEmpty (Pattern a)
_) | forall a. Pattern a -> Bool
noVar Pattern a
o   = forall a. Maybe a
Nothing
                                | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Pattern a -> DickinsonError a
SuspectPattern a
l Pattern a
o

checkPatternExpr :: Expression a -> Maybe (DickinsonError a)
checkPatternExpr :: forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Var{}              = forall a. Maybe a
Nothing
checkPatternExpr Literal{}          = forall a. Maybe a
Nothing
checkPatternExpr StrChunk{}         = forall a. Maybe a
Nothing
checkPatternExpr BuiltinFn{}        = forall a. Maybe a
Nothing
checkPatternExpr (Interp a
_ [Expression a]
es)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr [Expression a]
es
checkPatternExpr (MultiInterp a
_ [Expression a]
es) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr [Expression a]
es
checkPatternExpr (Apply a
_ Expression a
e Expression a
e')     = forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e'
checkPatternExpr (Match a
_ Expression a
e NonEmpty (Pattern a, Expression a)
brs)    = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. Pattern a -> Maybe (DickinsonError a)
checkPattern forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) NonEmpty (Pattern a, Expression a)
brs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e 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. Expression a -> Maybe (DickinsonError a)
checkPatternExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Pattern a, Expression a)
brs
checkPatternExpr (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. Expression a -> Maybe (DickinsonError a)
checkPatternExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Double, Expression a)
brs
checkPatternExpr (Concat a
_ [Expression a]
es)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr [Expression a]
es
checkPatternExpr (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. Expression a -> Maybe (DickinsonError a)
checkPatternExpr NonEmpty (Expression a)
es
checkPatternExpr (Lambda a
_ Name a
_ DickinsonTy a
_ Expression a
e)   = forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e
checkPatternExpr (Flatten a
_ Expression a
e)      = forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e
checkPatternExpr (Let a
_ NonEmpty (Name a, Expression a)
bs Expression a
e)       = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Name a, Expression a)
bs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e
checkPatternExpr (Bind a
_ NonEmpty (Name a, Expression a)
bs Expression a
e)      = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative (forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Name a, Expression a)
bs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e
checkPatternExpr (Annot a
_ Expression a
e DickinsonTy a
_)      = forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr Expression a
e
checkPatternExpr Constructor{}      = forall a. Maybe a
Nothing
checkPatternExpr Random{}           = forall a. Maybe a
Nothing

checkPatternDecl :: [Declaration a] -> Maybe (DickinsonError a)
checkPatternDecl :: forall a. [Declaration a] -> Maybe (DickinsonError a)
checkPatternDecl [Declaration a]
ds =
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. Expression a -> Maybe (DickinsonError a)
checkPatternExpr (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Declaration a -> Maybe (Expression a)
defExprM [Declaration a]
ds)