--------------------------------------------------------------------------------
{-# LANGUAGE TupleSections #-}


--------------------------------------------------------------------------------
module Console.Garepinoh.GenMain
    ( genMain
    , module Console.Garepinoh.Calculate
    ) where


--------------------------------------------------------------------------------
import Control.Monad.IO.Class (liftIO)
import Data.List              (find,intercalate,tails)
import Data.Maybe             (isNothing)
import System.Environment     (getArgs)


--------------------------------------------------------------------------------
import System.Console.Haskeline (runInputT,defaultSettings,InputT,getInputLine)


--------------------------------------------------------------------------------
import Console.Garepinoh.Calculate


--------------------------------------------------------------------------------
-- | A general @main@ function which behaves just like the @garepinoh@
-- executable, but depending on a 'Prelude'.
--
-- In fact, the @main@ function of the executable `garepinoh` is just
--
-- @
-- main = genMain 'Console.Garepinoh.Preludes.floatingPrelude'
-- @
-- 
-- whereas the main function of @garepiboh@ is:
-- 
-- @
-- main = genMain 'Console.Garepinoh.Preludes.boolPrelude'
-- @
genMain :: (Read t, Show t) => Prelude t-> IO ()
genMain fl =
    getArgs >>= \as ->
    runInputT defaultSettings $ loop as [] fl >> return ()


--------------------------------------------------------------------------------
loop :: (Read t, Show t)
     => [String] -> [String] -> Prelude t
     -> InputT IO ()
loop as postulates p =
    getLn as >>= \mayLn ->
    case fmap words mayLn of
        Nothing -- case: e.g. C-d
            -> return () -- don't change this! (because of loading)
        Just [] -- case: e.g. RET
            -> continue
        Just (",,":_) -- case: comment
            -> continue
        Just (",":name:[]) -- case: postulate
            | repl
            -> loop as (name:postulates) p
            | otherwise
            -> return ()
        Just (",":name:def@(_:_)) -- case: function definition
            | repl
            -> either
               ((>> continue) . liftIO . putStrLn)
               (loop as postulates)
               (addDef name def postulates p)
            | otherwise
            -> return ()
        Just ((',':',':cmd):ws) -- case: command
            | cmd `elem` helpList
            -> (>> continue) $ liftIO $ putStr $ helpText p
            | cmd `elem` cmndList
            -> (>> continue) $ liftIO $ putStr cmndText
            | cmd `elem` postList
            -> (>> continue) $ liftIO $ putStr $ postText p postulates
            | cmd `elem` funcList
            -> (>> continue) $ liftIO $ putStr $ funcText p
            | cmd `elem` exitList
            -> return ()
            | cmd `elem` ["l","load"] -- && null ws && not repl
              -- if ,load is the only command-line argument:
            -> loop [] postulates p
            | cmd `elem` ["scan","debug","trace"]
            -> (>> continue) $ mapM_ calc $
               map reverse $ reverse $ tails $ reverse ws -- TODO: make it better
            | otherwise
            -> return ()
        Just ws
            -> calc ws
            >> continue
      where
        continue
            | repl
            = loop as postulates p
            | otherwise
            = return ()
        calc ws = liftIO $ putStrLn $ either
                  (",,  Error: "++)
                  ((",,  "++) . show . reverse)
                  (calculate p ws)
        repl = null as


--------------------------------------------------------------------------------
addDef :: (Read t, Show t)
       => String -> [String] -> [String] -> Prelude t -> Either String (Prelude t)
addDef name def postulates p =
    case find invalid def of -- ugly.
        Nothing -> Right $ Func
            { symb = NEL name []
            , func = map Ref def
            } : p
        Just x
          | x `elem` postulates
            -> Left $ ",, Error: " ++ show x ++ " postulated but not defined."
          | otherwise
            -> Left $ ",,  Error: Unkown function " ++ show x ++ "."
  where
    invalid (',':d) = invalid d -- FIXME: this case is very critical and probably buggy! (is ,,x valid?)
    invalid d       = and
        [ d `notElem` concatMap (list . symb) p
        , isNothing $ asTypeOf (value d) $ Just $ Fu $ head p
        , d /= name
        , d `notElem` postulates
        ]


--------------------------------------------------------------------------------
getLn :: [String] -> InputT IO (Maybe String)
getLn as
  | null as   = getInputLine ""
  | otherwise = return $ Just $ unwords as


--------------------------------------------------------------------------------
funcText, helpText :: (Read t, Show t) => Prelude t -> String

funcText p = intercalate "\n"
    [ ",,  Functions (and Variables):"
    , printList p (list . symb)
    ]

helpText p = funcText p ++ cmndText

cmndText :: String
cmndText = intercalate "\n"
    [ ",,  Commands:"
    , ",,      Use commands by typing \",,<command>\" as the first word."
    , printList [exitList,helpList,funcList,cmndList] id
    ]

postText :: Prelude t -> [String] -> String
postText prelude postulates = intercalate "\n"
    [ ",, Postulates:"
    , flip printList id $ map return $ filter (`notElem` preluded) postulates
    ]
  where
    preluded = concatMap (list . symb) prelude


--------------------------------------------------------------------------------
exitList, funcList, helpList, cmndList, postList :: [String]
exitList = ["quit","q","exit","x"]
helpList = ["help","h"]
funcList = ["func","f","functions"]
cmndList = ["cmnd","c","commands"]
postList = ["post","p","postulates"]

printList :: [a] -> (a -> [String]) -> String
printList l f = flip concatMap l
              $ (++"\n") . (",,      * "++) . intercalate ", " . f