module Language.Dickinson.Check ( checkMultiple
                                ) where

import           Control.Applicative      (Alternative (..))
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

checkNames :: [Name a] -> Maybe (DickinsonWarning a)
checkNames :: forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames [Name a]
ns = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative forall a. [Name a] -> Maybe (DickinsonWarning a)
announce (forall a. Eq a => [a] -> [[a]]
group forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort [Name a]
ns)
    where announce :: [Name a] -> Maybe (DickinsonWarning 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 -> DickinsonWarning a
MultipleNames (forall a. Name a -> a
loc Name a
y) Name a
y
          announce [Name a]
_       = forall a. Maybe a
Nothing

-- runs after the renamer
-- | Checks that there are not name clashes at the top level or within let
-- bindings.
checkMultiple :: [Declaration a] -> Maybe (DickinsonWarning a)
checkMultiple :: forall a. [Declaration a] -> Maybe (DickinsonWarning a)
checkMultiple [Declaration a]
ds =
        forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. Declaration a -> Maybe (Name a)
defNameM [Declaration a]
ds)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. Declaration a -> Maybe (Name a)
tyDeclNameM [Declaration a]
ds)
    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 (DickinsonWarning a)
checkMultipleExpr (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Declaration a -> Maybe (Expression a)
defExprM [Declaration a]
ds)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Declaration a -> [TyName a]
collectConstructors [Declaration a]
ds)
    where defNameM :: Declaration a -> Maybe (Name a)
defNameM (Define a
_ Name a
n Expression a
_) = forall a. a -> Maybe a
Just Name a
n
          defNameM TyDecl{}       = forall a. Maybe a
Nothing
          tyDeclNameM :: Declaration a -> Maybe (Name a)
tyDeclNameM Define{}       = forall a. Maybe a
Nothing
          tyDeclNameM (TyDecl a
_ Name a
n NonEmpty (Name a)
_) = forall a. a -> Maybe a
Just Name a
n

collectConstructors :: Declaration a -> [TyName a]
collectConstructors :: forall a. Declaration a -> [TyName a]
collectConstructors Define{}        = []
collectConstructors (TyDecl a
_ Name a
_ NonEmpty (Name a)
cs) = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Name a)
cs

checkMultipleExpr :: Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr :: forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Var{}              = forall a. Maybe a
Nothing
checkMultipleExpr Literal{}          = forall a. Maybe a
Nothing
checkMultipleExpr StrChunk{}         = forall a. Maybe a
Nothing
checkMultipleExpr BuiltinFn{}        = forall a. Maybe a
Nothing
checkMultipleExpr (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 (DickinsonWarning a)
checkMultipleExpr [Expression a]
es
checkMultipleExpr (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 (DickinsonWarning a)
checkMultipleExpr [Expression a]
es
checkMultipleExpr (Apply a
_ Expression a
e Expression a
e')     = forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Expression a
e forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Expression a
e'
checkMultipleExpr (Match a
_ Expression a
e NonEmpty (Pattern a, Expression a)
brs)    = forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr 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 (DickinsonWarning a)
checkMultipleExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Pattern a, Expression a)
brs
checkMultipleExpr (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 (DickinsonWarning a)
checkMultipleExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Double, Expression a)
brs
checkMultipleExpr (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 (DickinsonWarning a)
checkMultipleExpr [Expression a]
es
checkMultipleExpr (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 (DickinsonWarning a)
checkMultipleExpr NonEmpty (Expression a)
es
checkMultipleExpr (Lambda a
_ Name a
_ DickinsonTy a
_ Expression a
e)   = forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Expression a
e
checkMultipleExpr (Flatten a
_ Expression a
e)      = forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Expression a
e
checkMultipleExpr (Let a
_ NonEmpty (Name a, Expression a)
bs Expression a
e)       =
        forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty (Name a, Expression a)
bs)
    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 (DickinsonWarning a)
checkMultipleExpr 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 (DickinsonWarning a)
checkMultipleExpr Expression a
e
checkMultipleExpr (Bind a
_ NonEmpty (Name a, Expression a)
bs Expression a
e)      =
        forall a. [Name a] -> Maybe (DickinsonWarning a)
checkNames (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty (Name a, Expression a)
bs)
    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 (DickinsonWarning a)
checkMultipleExpr 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 (DickinsonWarning a)
checkMultipleExpr Expression a
e
checkMultipleExpr (Annot a
_ Expression a
e DickinsonTy a
_)      = forall a. Expression a -> Maybe (DickinsonWarning a)
checkMultipleExpr Expression a
e
checkMultipleExpr Constructor{}      = forall a. Maybe a
Nothing
checkMultipleExpr Random{}           = forall a. Maybe a
Nothing