module Main (main) where

import           Control.Exception                   (throw)
import           Control.Exception.Value             (eitherThrow)
import           Control.Monad                       (void)
import           Criterion.Main
import           Data.Binary                         (decode, encode)
import qualified Data.ByteString.Lazy                as BSL
import qualified Data.Text                           as T
import           Language.Dickinson.Check
import           Language.Dickinson.Check.Duplicate
import           Language.Dickinson.Check.Exhaustive
import           Language.Dickinson.Check.Internal
import           Language.Dickinson.Check.Scope
import           Language.Dickinson.Error
import           Language.Dickinson.Eval
import           Language.Dickinson.File
import           Language.Dickinson.Lexer
import           Language.Dickinson.Parser
import           Language.Dickinson.Pipeline
import           Language.Dickinson.Rename
import           Language.Dickinson.Type
import           Language.Dickinson.TypeCheck
import           Language.Dickinson.Unique

benchPipeline :: FilePath -> Benchmark
benchPipeline fp = bench fp $ nfIO (pipeline [] fp)

benchValidate :: FilePath -> Benchmark
benchValidate fp = bench fp $ nfIO (validateFile [] fp)

main :: IO ()
main =
    defaultMain [ env parses $ \ ~(c, s) ->
                  bgroup "parse"
                    [ bench "lib/color.dck" $ nf parse c
                    , bench "lex lib/color.dck" $ nf lexDickinson c
                    , bench "examples/shakespeare.dck" $ nf parse s
                    ]
                , env libParsed $ \p ->
                  bgroup "renamer"
                    [ bench "bench/data/nestLet.dck" $ nf plainExpr p
                    ]
                , env (plainExpr <$> libParsed) $ \ ~(Dickinson _ r) ->
                  bgroup "scope checker"
                    [ bench "bench/data/nestLet.dck" $ nf checkScope r
                    ]
                , env (void <$> multiParsed) $ \p ->
                  bgroup "encoder"
                    [ bench "bench/data/multiple.dck" $ nf encode p
                    ]
                , env encodeEnv $ \ ~(e, es) ->
                  bgroup "decoder"
                    [ bench "bench/data/multiple.dck" $ nf (decode :: BSL.ByteString -> Dickinson ()) e
                    , bench "examples/shakespeare.dck" $ nf (decode :: BSL.ByteString -> Dickinson ()) es
                    ]
                , env checkEnv $ \ ~(Dickinson _ p, Dickinson _ p') ->
                  bgroup "check"
                    [ bench "bench/data/multiple.dck" $ nf checkMultiple p
                    , bench "lib/adjectives.dck" $ nf checkMultiple p'
                    , bench "bench/data/multiple.dck" $ nf checkDuplicates p -- TODO: better example
                    ]
                , env patternEnv $ \ ~(Dickinson _ p) ->
                  bgroup "pattern match exhaustiveness"
                    [ bench "test/examples/declension.dck" $ nf checkExhaustive p
                    ]
                , bgroup "pipeline"
                    [ benchPipeline "examples/shakespeare.dck"
                    , benchPipeline "examples/fortune.dck"
                    , benchPipeline "examples/catherineOfSienaBot.dck"
                    ]
                , bgroup "fileValidate"
                    [ benchValidate "test/examples/declension.dck"
                    , bench "lib/adjectives.dck" $ nfIO (validateFile ["lib"] "lib/adjectives.dck")
                    ]
                , env amalComplex $ \ ~(d, r) ->
                  bgroup "validate"
                    [ bench "test/examples/declension.dck" $ nf validateRun d
                    , bench "test/data/refractory.dck" $ nf validateRun r
                    ]
                , env amalFortune $ \f ->
                  bgroup "typecheck"
                    [ bench "examples/fortune.dck" $ nf tyRun f ]
                , env amalgamated $ \ ~(s, c, r) ->
                  bgroup "check + eval"
                    [ bench "examples/shakespeare.dck" $ nfIO (txtIO s)
                    , bench "examples/catherineOfSienaBot.dck" $ nfIO (txtIO c)
                    , bench "test/data/refractory" $ nfIO (txtIO r)
                    ]
                , env amalgamated $ \ ~(s, c, _) ->
                  bgroup "eval"
                    [ bench "examples/shakespeare.dck" $ nfIO (evalIO $ evalDickinsonAsMain s)
                    , bench "examples/catherineOfSienaBot.dck" $ nfIO (evalIO $ evalDickinsonAsMain c)
                    ]
                , env multiParsed $ \p ->
                  bgroup "maxUnique"
                    [ bench "bench/data/multiple.dck" $ nf maxUniqueDickinson p ]
                ]

    where libFile = BSL.readFile "lib/color.dck"
          shakespeare = BSL.readFile "examples/shakespeare.dck"
          parses = (,) <$> libFile <*> shakespeare
          libParsed = either throw id . parseWithMax <$> BSL.readFile "bench/data/nestLet.dck"
          multiParsed = either throw id . parse <$> BSL.readFile "bench/data/multiple.dck"
          libText = either throw id . parse <$> BSL.readFile "lib/adjectives.dck"
          encoded = encode . void <$> multiParsed
          encodeShakespeare = encode . void . either throw id . parse <$> shakespeare
          encodeEnv = (,) <$> encoded <*> encodeShakespeare
          amalFortune = amalgamateRename [] "examples/fortune.dck"
          amalgamated = (,,)
            <$> amalgamateRename [] "examples/shakespeare.dck"
            <*> amalgamateRename [] "examples/catherineOfSienaBot.dck"
            <*> amalgamateRename [] "test/data/refractory.dck"
          amalComplex = (,)
            <$> amalgamateRename [] "test/examples/declension.dck"
            <*> amalgamateRename [] "test/data/refractory.dck"
          checkEnv = (,)
            <$> multiParsed
            <*> libText
          patternEnv = either throw id . parse <$> BSL.readFile "test/examples/declension.dck"

plainExpr :: (UniqueCtx, Dickinson a) -> Dickinson a
plainExpr = fst . uncurry renameDickinson

-- FIXME: StdGen in env?
txtIO :: [Declaration AlexPosn] -> IO T.Text
txtIO = fmap eitherThrow . evalIO . checkEvalM

maxUniqueDickinson :: Dickinson AlexPosn -> Int
maxUniqueDickinson (Dickinson _ ds) = maximum (maxUniqueDeclaration <$> ds)

validateRun :: [Declaration a] -> Either (DickinsonError a) ()
validateRun = runTypeM . validateDecl