module Feldspar.Compiler.Frontend.CommandLine.API.Options where

import qualified Feldspar.Compiler.Backend.C.Options as CompilerCoreOptions
import qualified Feldspar.Compiler.Compiler as CompilerCore
import qualified Feldspar.Compiler.Frontend.CommandLine.API.Library as StandaloneLib
import Feldspar.Compiler.Frontend.CommandLine.API.Constants
import Feldspar.Compiler.Backend.C.Platforms

import Data.List
import Data.Char

import System.Console.GetOpt
import System.Exit
import System.Environment
import System.IO
import System.Process
import System.Info
import System.Directory

availablePlatformsStrRep = StandaloneLib.formatStringList $
                              map (StandaloneLib.upperFirst . CompilerCoreOptions.name) availablePlatforms

data FunctionMode = SingleFunction String | MultiFunction

data Options = Options  { optSingleFunction     :: FunctionMode
                        , optOutputFileName     :: Maybe String
                        , optCompilerMode       :: CompilerCoreOptions.Options
                        }

-- | Default options
startOptions :: Options
startOptions = Options  { optSingleFunction = MultiFunction
                        , optOutputFileName = Nothing
                        , optCompilerMode   = CompilerCore.defaultOptions
                        }

-- | Option descriptions for getOpt
optionDescriptors :: [ OptDescr (Options -> IO Options) ]
optionDescriptors =
    [ Option "f" ["singlefunction"]
        (ReqArg
            (\arg opt -> return opt { optSingleFunction = SingleFunction arg })
            "FUNCTION")
        "Enables single-function compilation"

    , Option "o" ["output"]
        (ReqArg
            (\arg opt -> return opt { optOutputFileName = Just arg })
            "outputfile.c")
        "Overrides the file name for the generated output code"

    , Option "p" ["platform"]
        (ReqArg
            (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)
                                         { CompilerCoreOptions.platform = decodePlatform arg } })
            "<platform>")
        ("Overrides the target platform " ++ availablePlatformsStrRep)
     , Option "u" ["unroll"]
        (ReqArg
            (\arg opt -> return opt {
                optCompilerMode = (optCompilerMode opt) {
                    CompilerCoreOptions.unroll = CompilerCoreOptions.Unroll (parseInt arg "Invalid unroll count")
                }
            })
            "<unrollCount>")
        "Enables loop unrolling"
     , Option "D" ["debuglevel"]
        (ReqArg
            (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)
                                         { CompilerCoreOptions.debug = decodeDebug arg } })
            "<level>")
        "Specifies debug level (currently the only possible option is NoPrimitiveInstructionHandling)"
     , Option "a" ["defaultArraySize"]
        (ReqArg
            (\arg opt -> return opt {
                optCompilerMode = (optCompilerMode opt) {
                    CompilerCoreOptions.defaultArraySize = parseInt arg "Invalid default array size"
                }
            })
            "<size>")
        "Overrides default array size"

    , Option "h" ["help"]
        (NoArg
            (\_ -> do
                --prg <- getProgName
                hPutStrLn stderr (usageInfo helpHeader optionDescriptors)
                exitWith ExitSuccess))
        "Show this help message"
    ]

-- ==============================================================================
--  == Option Decoders
-- ==============================================================================

findPlatformByName :: String -> Maybe CompilerCoreOptions.Platform
findPlatformByName platformName = -- Finds a platform by name using case-insensitive comparison
    find (\platform -> (map toLower platformName) == (map toLower $ CompilerCoreOptions.name platform))
         availablePlatforms

decodePlatform :: String -> CompilerCoreOptions.Platform
decodePlatform s = case (findPlatformByName s) of
    Just platform  -> platform
    Nothing        -> error $ "Invalid platform specified. Valid platforms are: " ++ availablePlatformsStrRep

decodeDebug "NoPrimitiveInstructionHandling" = CompilerCoreOptions.NoPrimitiveInstructionHandling
decodeDebug _ = error "Invalid debug level specified"

parseInt :: String -> String -> Int
parseInt arg message = case reads arg of
    [(x, "")] -> x
    _ -> error message