homePage :: ServerPart Response
homePage = msum [ dir "day1" day1
                , dir "day2" day2
                , dir "day3" day3
                , dir "day4" day4
                , dir "day5" day5
                , day1 ]
   where

     day lexiconFile modelFile baseDir example day notesFile modelPrefFile= do
          res <- liftIO $ loadResources lexiconFile modelFile baseDir example day notesFile modelPrefFile
          msum [viewForm res, processForm res]

     day1 = day "data/day1_lexicon" "data/day1_model" "day1/" day1Example "Day 1" "data/day1_notes.html" "data/model_prefix"
     day2 = day "data/day2_lexicon" "data/day2_model" "day2/" day2Example "Day 2" "data/day2_notes.html" "data/model_prefix"
     day3 = day "data/day3_lexicon" "data/day3_model" "day3/" day3Example "Day 3" "data/day3_notes.html" "data/model_prefix"
     day4 = day "data/day4_lexicon" "data/day4_model" "day4/" day4Example "Day 4" "data/day4_notes.html" "data/model_prefix_with_db"
     day5 = day "data/day5_lexicon" "data/day5_model" "day5/" day5Example "Day 5" "data/day5_notes.html" "data/model_prefix_with_db"

     viewForm :: Resources -> ServerPart Response
     viewForm res =
         do Happstack.Lite.method GET
            ok $ toResponse $ pageTemplate res

     processForm :: Resources -> ServerPart Response
     processForm res =
         do Happstack.Lite.method [GET,POST]
            raw_lex <- lookText "lexicon"
            sent <- lookText "sentence"
            m <- lookText "model"
            lex <- return $ parseLexicon $ unpack raw_lex
            -- we verify the lexicon
            if Main.isLeft lex then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft lex}
              else do
            seq <- return $ parseSequent (unpack sent) $ fromRight lex
            -- we verify the sequent
            if Main.isLeft seq then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft seq}
              else do
            ps <- return $ evaluateState (toDecoratedWithConstants (fromRight seq) >>= \(ds,m) -> TP.proofs ds >>= \p -> return $ replaceWithConstants p m) startState
            ps <- return $ nubByShortest (lambdaTermLength . term . snd . getVal) (\x y -> simplifiedEquivalentDecoratedSequent (getVal x) (getVal y)) $ map sanitizeVars ps
            rs <- mapM (\p -> liftIO $ performEvaluation (unpack m) (modelPref res) (term $ snd $ getVal p)) ps
            ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = ps, sentence= unpack sent, model = unpack m, readings = rs}


-- |This function performs the evaluation in a different thread, hopefully overcoming the problems with hint
homePage :: ServerPart Response
homePage = msum [ dir "day1" day1
                , dir "day2" day2
                , dir "day3" day3
                , dir "day4" day4
                , dir "day5" day5
                , day1 ]
   where

     day lexiconFile modelFile baseDir example day notesFile modelPrefFile= do
          res <- liftIO $ loadResources lexiconFile modelFile baseDir example day notesFile modelPrefFile
          msum [viewForm res, processForm res]

     day1 = day "data/day1_lexicon" "data/day1_model" "day1/" day1Example "Day 1" "data/day1_notes.html" "data/model_prefix"
     day2 = day "data/day2_lexicon" "data/day2_model" "day2/" day2Example "Day 2" "data/day2_notes.html" "data/model_prefix"
     day3 = day "data/day3_lexicon" "data/day3_model" "day3/" day3Example "Day 3" "data/day3_notes.html" "data/model_prefix"
     day4 = day "data/day4_lexicon" "data/day4_model" "day4/" day4Example "Day 4" "data/day4_notes.html" "data/model_prefix_with_db"
     day5 = day "data/day5_lexicon" "data/day5_model" "day5/" day5Example "Day 5" "data/day5_notes.html" "data/model_prefix_with_db"

     viewForm :: Resources -> ServerPart Response
     viewForm res =
         do Happstack.Lite.method GET
            ok $ toResponse $ pageTemplate res

     processForm :: Resources -> ServerPart Response
     processForm res =
         do Happstack.Lite.method [GET,POST]
            raw_lex <- lookText "lexicon"
            sent <- lookText "sentence"
            m <- lookText "model"
            lex <- return $ parseLexicon $ unpack raw_lex
            -- we verify the lexicon
            if Main.isLeft lex then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft lex}
              else do
            seq <- return $ parseSequent (unpack sent) $ fromRight lex
            -- we verify the sequent
            if Main.isLeft seq then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft seq}
              else do
            ps <- return $ evaluateState (toDecoratedWithConstants (fromRight seq) >>= \(ds,m) -> TP.proofs ds >>= \p -> return $ replaceWithConstants p m) startState
            ps <- return $ nubByShortest (lambdaTermLength . term . snd . getVal) (\x y -> simplifiedEquivalentDecoratedSequent (getVal x) (getVal y)) $ map sanitizeVars ps
            rs <- mapM (\p -> liftIO $ performEvaluation (unpack m) (modelPref res) (term $ snd $ getVal p)) ps
            ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = ps, sentence= unpack sent, model = unpack m, readings = rs}


-- |This function performs the evaluation in a different thread, hopefully overcoming the problems with hint
homePage = msum [ dir "day1" day1
                , dir "day2" day2
                , dir "day3" day3
                , dir "day4" day4
                , dir "day5" day5
                , day1 ]
   where

     day lexiconFile modelFile baseDir example day notesFile modelPrefFile= do
          res <- liftIO $ loadResources lexiconFile modelFile baseDir example day notesFile modelPrefFile
          msum [viewForm res, processForm res]

     day1 = day "data/day1_lexicon" "data/day1_model" "day1/" day1Example "Day 1" "data/day1_notes.html" "data/model_prefix"
     day2 = day "data/day2_lexicon" "data/day2_model" "day2/" day2Example "Day 2" "data/day2_notes.html" "data/model_prefix"
     day3 = day "data/day3_lexicon" "data/day3_model" "day3/" day3Example "Day 3" "data/day3_notes.html" "data/model_prefix"
     day4 = day "data/day4_lexicon" "data/day4_model" "day4/" day4Example "Day 4" "data/day4_notes.html" "data/model_prefix_with_db"
     day5 = day "data/day5_lexicon" "data/day5_model" "day5/" day5Example "Day 5" "data/day5_notes.html" "data/model_prefix_with_db"

     viewForm :: Resources -> ServerPart Response
     viewForm res =
         do Happstack.Lite.method GET
            ok $ toResponse $ pageTemplate res

     processForm :: Resources -> ServerPart Response
     processForm res =
         do Happstack.Lite.method [GET,POST]
            raw_lex <- lookText "lexicon"
            sent <- lookText "sentence"
            m <- lookText "model"
            lex <- return $ parseLexicon $ unpack raw_lex
            -- we verify the lexicon
            if Main.isLeft lex then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft lex}
              else do
            seq <- return $ parseSequent (unpack sent) $ fromRight lex
            -- we verify the sequent
            if Main.isLeft seq then
              ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = [], sentence= unpack sent, model = unpack m, readings = [], error_msg = Just $ fromLeft seq}
              else do
            ps <- return $ evaluateState (toDecoratedWithConstants (fromRight seq) >>= \(ds,m) -> TP.proofs ds >>= \p -> return $ replaceWithConstants p m) startState
            ps <- return $ nubByShortest (lambdaTermLength . term . snd . getVal) (\x y -> simplifiedEquivalentDecoratedSequent (getVal x) (getVal y)) $ map sanitizeVars ps
            rs <- mapM (\p -> liftIO $ performEvaluation (unpack m) (modelPref res) (term $ snd $ getVal p)) ps
            ok $ toResponse $ pageTemplate res{ Main.lexicon = unpack raw_lex, Main.proofs = ps, sentence= unpack sent, model = unpack m, readings = rs}


-- |This function performs the evaluation in a different thread, hopefully overcoming the problems with hint