module Language.Dickinson.Check.Internal ( sanityCheck
                                         , sanityCheckLexer
                                         , maxUniqueDeclaration
                                         ) where

import           Control.Monad             (when)
import           Control.Monad.State       (MonadState)
import           Data.List.NonEmpty        ((<|))
import           Language.Dickinson.Lexer
import           Language.Dickinson.Name
import           Language.Dickinson.Rename
import           Language.Dickinson.Type
import           Language.Dickinson.Unique
import           Lens.Micro                (_1)
import           Lens.Micro.Mtl            (use)

sanityCheckLexer :: (HasLexerState s, MonadState s m) => [Declaration a] -> m ()
sanityCheckLexer :: forall s (m :: * -> *) a.
(HasLexerState s, MonadState s m) =>
[Declaration a] -> m ()
sanityCheckLexer [Declaration a]
d = do
    Int
storedMax <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall a. HasLexerState a => Lens' a AlexUserState
lexerStateLensforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_1)
    let computedMax :: Int
computedMax = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. Declaration a -> Int
maxUniqueDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration a]
d)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
storedMax forall a. Ord a => a -> a -> Bool
< Int
computedMax) forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => [Char] -> a
error [Char]
"Sanity check failed!"

-- | Sanity check for the renamer.
sanityCheck :: (HasRenames s, MonadState s m) => [Declaration a] -> m ()
sanityCheck :: forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
[Declaration a] -> m ()
sanityCheck [Declaration a]
d = do
    Int
storedMax <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall a. HasRenames a => Lens' a Renames
renameforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Renames Int
maxLens)
    let computedMax :: Int
computedMax = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. Declaration a -> Int
maxUniqueDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration a]
d)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
storedMax forall a. Ord a => a -> a -> Bool
< Int
computedMax) forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => [Char] -> a
error [Char]
"Sanity check failed!"

-- TODO: see http://hackage.haskell.org/package/uniplate-1.6.12/docs/Data-Generics-Uniplate-Operations.html
-- TODO: recursion schemes? would need benchmark...
-- | I exported this so I could benchmark it
maxUniqueDeclaration :: Declaration a -> Int
maxUniqueDeclaration :: forall a. Declaration a -> Int
maxUniqueDeclaration (Define a
_ (Name NonEmpty Text
_ (Unique Int
i) a
_) Expression a
e)   = forall a. Ord a => a -> a -> a
max Int
i (forall a. Expression a -> Int
maxUniqueExpression Expression a
e)
maxUniqueDeclaration (TyDecl a
_ (Name NonEmpty Text
_ (Unique Int
i) a
_) NonEmpty (Name a)
tns) =
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ( Int
i forall a. a -> NonEmpty a -> NonEmpty a
<| forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unique -> Int
unUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> Unique
unique) NonEmpty (Name a)
tns)

maxUniqueType :: DickinsonTy a -> Int
maxUniqueType :: forall a. DickinsonTy a -> Int
maxUniqueType TyText{}                          = Int
0
maxUniqueType (TyFun a
_ DickinsonTy a
ty DickinsonTy a
ty')                  = forall a. Ord a => a -> a -> a
max (forall a. DickinsonTy a -> Int
maxUniqueType DickinsonTy a
ty) (forall a. DickinsonTy a -> Int
maxUniqueType DickinsonTy a
ty')
maxUniqueType (TyTuple a
_ NonEmpty (DickinsonTy a)
ts)                    = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DickinsonTy a -> Int
maxUniqueType NonEmpty (DickinsonTy a)
ts)
maxUniqueType (TyNamed a
_ (Name NonEmpty Text
_ (Unique Int
k) a
_)) = Int
k

maxUniqueExpression :: Expression a -> Int
maxUniqueExpression :: forall a. Expression a -> Int
maxUniqueExpression BuiltinFn{}                           = Int
0
maxUniqueExpression Literal{}                             = Int
0
maxUniqueExpression (Random a
_ (Name NonEmpty Text
_ (Unique Int
k) a
_))      = Int
k
maxUniqueExpression (Constructor a
_ (Name NonEmpty Text
_ (Unique Int
k) a
_)) = Int
k
maxUniqueExpression StrChunk{}                            = Int
0
maxUniqueExpression (Var a
_ (Name NonEmpty Text
_ (Unique Int
i) a
_))         = Int
i
maxUniqueExpression (Choice a
_ NonEmpty (Double, Expression a)
pes)                        = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. Expression a -> Int
maxUniqueExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Double, Expression a)
pes)
maxUniqueExpression (MultiInterp a
_ [Expression a]
es)                    = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Expression a -> Int
maxUniqueExpression [Expression a]
es)
maxUniqueExpression (Interp a
_ [Expression a]
es)                         = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Expression a -> Int
maxUniqueExpression [Expression a]
es)
maxUniqueExpression (Concat a
_ [Expression a]
es)                         = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Expression a -> Int
maxUniqueExpression [Expression a]
es)
maxUniqueExpression (Apply a
_ Expression a
e Expression a
e')                        = forall a. Ord a => a -> a -> a
max (forall a. Expression a -> Int
maxUniqueExpression Expression a
e) (forall a. Expression a -> Int
maxUniqueExpression Expression a
e')
maxUniqueExpression (Annot a
_ Expression a
e DickinsonTy a
ty)                        = forall a. Ord a => a -> a -> a
max (forall a. Expression a -> Int
maxUniqueExpression Expression a
e) (forall a. DickinsonTy a -> Int
maxUniqueType DickinsonTy a
ty)
maxUniqueExpression (Flatten a
_ Expression a
e)                         = forall a. Expression a -> Int
maxUniqueExpression Expression a
e
maxUniqueExpression (Tuple a
_ NonEmpty (Expression a)
es)                          = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Expression a -> Int
maxUniqueExpression NonEmpty (Expression a)
es)
maxUniqueExpression (Lambda a
_ (Name NonEmpty Text
_ (Unique Int
i) a
_) DickinsonTy a
ty Expression a
e) =
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
i
            , forall a. Expression a -> Int
maxUniqueExpression Expression a
e
            , forall a. DickinsonTy a -> Int
maxUniqueType DickinsonTy a
ty
            ]
maxUniqueExpression (Match a
_ Expression a
e NonEmpty (Pattern a, Expression a)
brs)                       =
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
        [ forall a. Expression a -> Int
maxUniqueExpression Expression a
e
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Pattern a -> Int
maxUniquePattern forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) NonEmpty (Pattern a, Expression a)
brs)
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Expression a -> Int
maxUniqueExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Pattern a, Expression a)
brs)
        ]
maxUniqueExpression (Let a
_ NonEmpty (Name a, Expression a)
bs Expression a
e) =
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
        [ forall a. Expression a -> Int
maxUniqueExpression Expression a
e
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. Expression a -> Int
maxUniqueExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs)
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Unique -> Int
unUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> Unique
unique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs)
        ]
maxUniqueExpression (Bind a
_ NonEmpty (Name a, Expression a)
bs Expression a
e) =
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
        [ forall a. Expression a -> Int
maxUniqueExpression Expression a
e
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. Expression a -> Int
maxUniqueExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs)
        , forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Unique -> Int
unUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> Unique
unique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs)
        ]

maxUniquePattern :: Pattern a -> Int
maxUniquePattern :: forall a. Pattern a -> Int
maxUniquePattern (PatternVar a
_ (Name NonEmpty Text
_ (Unique Int
i) a
_))  = Int
i
maxUniquePattern Wildcard{}                            = Int
0
maxUniquePattern (PatternTuple a
_ NonEmpty (Pattern a)
ps)                   = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Pattern a -> Int
maxUniquePattern NonEmpty (Pattern a)
ps)
maxUniquePattern (PatternCons a
_ (Name NonEmpty Text
_ (Unique Int
k) a
_)) = Int
k
maxUniquePattern (OrPattern a
_ NonEmpty (Pattern a)
ps)                      = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Pattern a -> Int
maxUniquePattern NonEmpty (Pattern a)
ps)