module DDC.Build.Platform
        ( Platform      (..)
        , staticFileExtensionOfPlatform
        , sharedFileExtensionOfPlatform

        , Arch          (..)
        , archPointerWidth

        , Os            (..)

        -- * Host platform
        , determineHostPlatform
        , determineHostArch
        , determineHostOs
        , determineHostLlvmVersion)
where
import DDC.Data.Pretty
import Data.List                as List
import Data.Maybe               as Maybe
import Data.Char                as Char
import qualified System.Process as System
import qualified System.Exit    as System


-------------------------------------------------------------------------------
-- | Describes a build or target platform.
data Platform
        = Platform
        { platformArch  :: Arch
        , platformOs    :: Os }
        deriving (Eq, Show)

instance Pretty Platform where
 ppr platform
  = vcat
  [ text "Processor Architecture : " <> ppr (platformArch platform)
  , text "Operating System       : " <> ppr (platformOs   platform) ]


-- | Get the file extension to use for a static library on this platform.
staticFileExtensionOfPlatform :: Platform -> String
staticFileExtensionOfPlatform pp
 = case platformOs pp of
        OsDarwin{}      -> "a"
        OsLinux         -> "a"
        OsCygwin        -> "a"
        OsMingw         -> "a"


-- | Get the file extension to use for a shared library on this platform.
sharedFileExtensionOfPlatform :: Platform -> String
sharedFileExtensionOfPlatform pp
 = case platformOs pp of
        OsDarwin{}      -> "dylib"
        OsLinux         -> "so"
        OsCygwin        -> "so"
        OsMingw         -> "dll"


-------------------------------------------------------------------------------
-- | Processor Architecture.
data Arch
        = ArchX86_32
        | ArchX86_64
        | ArchPPC_32
        | ArchPPC_64
        deriving (Eq, Show)

instance Pretty Arch where
 ppr arch
  = case arch of
        ArchX86_32      -> text "x86 32-bit"
        ArchX86_64      -> text "x86 64-bit"
        ArchPPC_32      -> text "PPC 32-bit"
        ArchPPC_64      -> text "PPC 64-bit"


-- | Get the width of a pointer on the architecture, in bits.
archPointerWidth :: Arch -> Int
archPointerWidth arch
 = case arch of
        ArchX86_32      -> 32
        ArchX86_64      -> 64
        ArchPPC_32      -> 32
        ArchPPC_64      -> 64


-------------------------------------------------------------------------------
-- | Operating System.
data Os
        -- | Darwin, including the major, minor and patch numbers, 
        --   if specified.
        = OsDarwin (Maybe (Int, Int, Int))

        -- | Generic Linux.
        | OsLinux

        -- | Cygwin on Windows.
        | OsCygwin

        -- | MinGW  on Windows.
        | OsMingw
        deriving (Eq, Show)

instance Pretty Os where
 ppr os
  = case os of
        OsDarwin{}      -> text "Darwin"
        OsLinux         -> text "Linux"
        OsCygwin        -> text "Cygwin"
        OsMingw         -> text "Mingw"


-- Determinators --------------------------------------------------------------
-- | Determine the default host platform.
--
--   Uses the @arch@ and @uname@ commands which must be in the current path.
--
--   Returns `Nothing` if @arch@ or @uname@ cannot be found, returned
--   an error, or we didn't recognise their response.
--
--   For Platforms like Darwin which can run both 32-bit and 64-bit binaries,
--   we return whatever the default is reported by 'arch' and 'uname'.
determineHostPlatform :: IO (Maybe Platform)
determineHostPlatform
 = do   mArch   <- determineHostArch
        mOs     <- determineHostOs

        case (mArch, mOs) of
         (Just arch, Just os)   -> return $ Just (Platform arch os)
         _                      -> return Nothing


-- | Determine the host archicture.
--   Uses the 'arch' command which must be in the current path.
determineHostArch :: IO (Maybe Arch)
determineHostArch
 = do   (exitCode, strArch, _) 
         <- System.readProcessWithExitCode "uname" ["-m"] ""

        let result
                | System.ExitFailure{} <- exitCode     
                = Nothing

                | isPrefixOf "i386"   strArch   = Just ArchX86_32
                | isPrefixOf "i486"   strArch   = Just ArchX86_32
                | isPrefixOf "i586"   strArch   = Just ArchX86_32
                | isPrefixOf "i686"   strArch   = Just ArchX86_32
                | isPrefixOf "x86_64" strArch   = Just ArchX86_64
                | isPrefixOf "ppc"    strArch   = Just ArchPPC_32
                | isPrefixOf "ppc64"  strArch   = Just ArchPPC_64
                | otherwise                     = Nothing

        return result


-- | Determine the host OS.
--   Uses the 'uname' command which must be in the current path.
determineHostOs :: IO (Maybe Os)
determineHostOs 
 = do   (exitCode, strOs, _)
         <- System.readProcessWithExitCode "uname" [] ""
        
        case exitCode of
         System.ExitFailure{}
          -> return Nothing

         System.ExitSuccess
          |  isPrefixOf "Darwin" strOs  -> determineHostOsDarwin
          |  isPrefixOf "Linux"  strOs  -> return $ Just OsLinux
          |  isPrefixOf "CYGWIN" strOs  -> return $ Just OsCygwin
          |  isPrefixOf "MINGW"  strOs  -> return $ Just OsMingw
          |  otherwise                  -> return Nothing


-- | Given that we're running on Darwin, determine the version numbers.
determineHostOsDarwin :: IO (Maybe Os)
determineHostOsDarwin 
 = do   (exitCode, strVersion, _)
         <- System.readProcessWithExitCode "uname" ["-r"] ""

        case exitCode of
         System.ExitFailure{}
          -> return Nothing

         System.ExitSuccess
          | (dsMajor, '.' : rest1) <- List.span isDigit strVersion
          , nMajor                 <- read dsMajor
          , (dsMinor, '.' : rest2) <- List.span isDigit rest1
          , nMinor                 <- read dsMinor
          , (dsPatch, _)           <- List.span isDigit rest2
          , nPatch                 <- read dsPatch
          -> return $ Just $ OsDarwin (Just (nMajor, nMinor, nPatch))

          | otherwise
          -> return $ Nothing


-- | Determine the host LLVM version string, eg "3.5.2"
--   Takes the path to the LLVM compiler to use, 
--   or `Nothing` to use whatever is in the current path.
determineHostLlvmVersion :: Maybe FilePath -> IO (Maybe String)
determineHostLlvmVersion mpath
 = do
        let path    = fromMaybe "llc" mpath
        (exitCode, strAll, _)
         <- System.readProcessWithExitCode path ["-version"] ""

        case exitCode of 
         System.ExitFailure{}
          -> return Nothing

         System.ExitSuccess
          -> do -- Supplying -version gives us the LLVM title as well as
                -- a list of all registered targets.
                let ls      = map      (takeWhile $ not . Char.isSpace)
                            $ map      (dropWhile Char.isSpace)
                            $ mapMaybe (stripPrefix "LLVM version")
                            $ map      (dropWhile Char.isSpace)
                            $ lines strAll

                case ls of
                 [str]  -> return $ Just str
                 _      -> return Nothing