{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Control.Monad.Random            (evalRandIO)

import           Data.List                       (find)

import           Options.Applicative

import           Language.ArrayForth.Distance    (Distance, registers)
import           Language.ArrayForth.Interpreter (eval)
import           Language.ArrayForth.Parse       ()
import           Language.ArrayForth.Program     (Program, load, readProgram)
import           Language.ArrayForth.State       (State (..), startState)
import           Language.ArrayForth.Synthesis   (defaultMutations, defaultOps,
                                                  evaluate)

import qualified Language.Synthesis.Distribution as Distr
import           Language.Synthesis.Synthesis    (Problem (..), runningBest,
                                                  synthesizeMhList)

data Options = Options { verbose :: Bool }

options :: Parser Options
options =  Options <$> switch (long "verbose" <>
                               short 'v' <>
                               help "Print intermediate state to STDOUT.")

specP :: Parser Program
specP = argument (either (const Nothing) Just . readProgram) (metavar "SPEC")

main :: IO ()
main = do Options { verbose } <- execParser go
          if verbose then verbosely else run
  where go = info (helper <*> options) (fullDesc <>
                                        progDesc "Synthesize arrayForth programs using MCMC." <>
                                        header "mcmc-demo - simple synthesis with MCMC")

good :: (Program, Double) -> Bool
good (_, val) = val >= 0.5

verbosely :: IO ()
verbosely = do ls <- evalRandIO (synthesizeMhList inclusiveOr)
               mapM_ print . zip ls . takeWhile (not . good) $ runningBest ls

run :: IO ()
run = evalRandIO (synthesizeMhList inclusiveOr) >>= print . find good . runningBest

test :: Distance -> String -> String -> State -> Double
test distance p₁ p₂ input = let r₁ = eval $ load (read p₁) input
                                r₂ = eval $ load (read p₂) input in
                            distance r₁ r₂

inclusiveOr :: Problem Program
inclusiveOr = Problem { score = evaluate program cases distance
                      , prior = Distr.replicate 8 defaultOps
                      , jump  = defaultMutations }
  where program = read "over over or a! and a or"
        cases = [startState {t = 0, s = 123}, startState {t = maxBound, s = 123},
                 startState {t = 1, s = 123}, startState {t = maxBound - 1, s = 123}]
        distance = registers [t]