{-# LANGUAGE Haskell2010
 #-}
{-# OPTIONS
    -Wall
    -fno-warn-name-shadowing
 #-}

{- | The @j2hs@ command - create Haskell bindings for Java classes.
    
-}
module Java2Haskell where

import Prelude hiding (print)

import Options
import Utils
import Types
import Segments
import CodeGen.Class
import CodeGen.JavaBindings

import Foreign.Java
import Foreign.Java.IO

import Language.Java.Reflect

import Data.NamedRecord
import qualified Data.List as L
import Data.Strings

import Data.Generics

import Data.Map (Map)
import MultiMap (MultiMap)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified MultiMap as MultiMap

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class

import System.Directory
import System.FilePath
import System.IO hiding (print)
import qualified System.IO.Strict as Strict
import System.Exit

import Haskell.X


ifVerbose
    :: MonadIO m
    => Options
    -> String
    -> m ()
ifVerbose opts = when (opts `get` optVerbose) . liftIO . putStr

-- | Invoked by Main.main, the core functionality
j2hs
    :: Options
    -> [String]
    -> IO ()
j2hs opts args = do

    let augmentEnvironment = do
            targetDir <- return (opts `get` optTargetDirectory)
            createDirectoryIfMissing True targetDir

            classpath <- mapM canonicalizePath $ opts `get` optClasspath

            cabalExtra <- if null (opts `get` optCabalPreset)
                then return ""
                else Strict.readFile (opts `get` optCabalPreset)

            setCurrentDirectory targetDir

            return $ opts
              `set` optClasspath := classpath
              `set` optTargetDirectory := targetDir
              `set` optCabalExtra := cabalExtra

    reflectDump <- if null (opts `get` optLoadReflectDump)
        then return Nothing
        else Just <$> canonicalizePath (opts `get` optLoadReflectDump)

    opts <- augmentEnvironment

    let classpath = opts `get` optClasspath
        classpath' = concat $ L.intersperse ":" classpath

    ifVerbose opts ((\_ -> let { __ = 
{-# LINE 92 "Java2Haskell.hss" #-}
concat ["Classpath:\n", (concatMap (\x -> "  " ++ x ++ "\n") (classpath)), ""]
{-# LINE 94 "Java2Haskell.hss" #-}
} in __) undefined)
    print "Initializing JVM..."
    initJava [((\_ -> let { __ = 
{-# LINE 96 "Java2Haskell.hss" #-}
concat ["-Djava.class.path=", (classpath'), ""]
{-# LINE 96 "Java2Haskell.hss" #-}
} in __) undefined)]
    println " Done."
    
    unless (null args) $ runJava $ do
        io $ do
            ifVerbose opts ((\_ -> let { __ = 
{-# LINE 101 "Java2Haskell.hss" #-}
concat ["Target Directory:\n  ", (opts `get` optTargetDirectory), "\n"]
{-# LINE 104 "Java2Haskell.hss" #-}
} in __) undefined)
            
        ifVerbose opts ((\_ -> let { __ = 
{-# LINE 106 "Java2Haskell.hss" #-}
concat ["Looking for Java classes:\n", (concatMap (\x -> "  " ++ x ++ "\n") args), ""]
{-# LINE 108 "Java2Haskell.hss" #-}
} in __) undefined)

        classInfo <- gatherClassInfo opts reflectDump args

        when (opts `get` optOnlyReflect) $ io $ do
            mapM_ println $ Map.elems classInfo
            exitSuccess

        -- Calculate the Haskell module names for packages and classes
        let classes = Map.keys classInfo

            packages = Set.toList $ Set.fromList
                     $ map (maybe "" id . takePackageName) classes

            -- temporary class names
            classModules_ = foldr (uncurry g) xEmpty $ map f classes
              where f x = (x, makeClassModuleName x)
                    g clazzName modName all = xInsert clazzName newName all
                      where newName = head $ dropWhile (`xMemberR` all)
                                           $ iterate (++ "_") modName

            -- package names.
            -- This func keeps in mind that package names must not clash with class names.
            packageModules = foldr (uncurry g) xEmpty $ map f packages
              where f x = (x, makePackageModuleName x)
                    g pkgName modName all = xInsert pkgName newName all
                      where newName = head $ dropWhile (\n -> n `xMemberR` classModules_
                                                           || n `xMemberR` all)
                                           $ iterate (++ "Package") modName

            bimapCheckedLookup bimap name
                = maybe (error ((\_ -> let { __ = 
{-# LINE 139 "Java2Haskell.hss" #-}
concat ["Failed lookup in Bimap: ", (show name), "."]
{-# LINE 139 "Java2Haskell.hss" #-}
} in __) undefined)) id $ xLookup bimap name

            mapCheckedLookup map name
                = maybe (error ((\_ -> let { __ = 
{-# LINE 142 "Java2Haskell.hss" #-}
concat ["Failed lookup in Map: ", (show name), ""]
{-# LINE 142 "Java2Haskell.hss" #-}
} in __) undefined)) id $ name `Map.lookup` map

            -- finally the class names.
            -- This func keeps in mind that the package names might have been augmented
            -- before. i.e. the package java.awt.image will be Java.Awt.ImagePackage now,
            -- thus all classes inside the package have their full name changed too.
            classModules :: Map String String
            classModules = Map.fromList $ map f $ xToList classModules_
              where f (clazzName, moduleName)
                        = (clazzName, joinClassName (newPackageName, classModuleName))
                      where classModuleName = takeClassName moduleName
                            packageName = maybe "" id $ takePackageName clazzName
                            newPackageName = bimapCheckedLookup packageModules packageName

            -- A mapping from packages to classes
            classesByPackage :: MultiMap String String
            classesByPackage = MultiMap.fromList
                             $ map (\clazz -> (fst $ splitClassName clazz, clazz)) classes

        -- Find a suitable segmentation
        rankedClusters <- findClassClusters classInfo

        let segmentSize = min (fromIntegral (opts `get` optSegmentSize)) (Map.size classInfo)
            segments = segment3 segmentSize rankedClusters
            lengths = concat $ L.intersperse ", " $ map (show . length) segments

        println ((\_ -> let { __ = 
{-# LINE 168 "Java2Haskell.hss" #-}
concat ["Identified ", (show $ length segments), " segments of lengths (", (lengths), ")."]
{-# LINE 168 "Java2Haskell.hss" #-}
} in __) undefined)

        -- Assemble the class info
        let info = ClassInfo {
          aboutClass = mapCheckedLookup classInfo,
          classesForPackage = flip MultiMap.lookup classesByPackage,
          classModName = mapCheckedLookup classModules,
          packageModName = bimapCheckedLookup packageModules,
          allClasses = Map.keys classModules,
          allPackages = xKeys packageModules
        }

        -- Create the code files.
        let pName = opts `get` optProjectName
            pVersion = opts `get` optProjectVersion
            mkDeps = map (\i -> pName ++ "-part" ++ show i ++ " == " ++ pVersion)

        cwd <- io $ getCurrentDirectory
        forM_ (zip [1 :: Int ..] segments) $ \(i, segment) -> do
            io $ do
                setCurrentDirectory cwd
                createDirectoryIfMissing True (show i)
                setCurrentDirectory (show i)
            let opts' = opts
                  `upd` optProjectName  := (++ "-part" ++ show i)
                  `upd` optDependencies := (++ mkDeps [1..pred i])
            generateClassModules opts' info segment
        io $ setCurrentDirectory cwd

        let deps = mkDeps [1..length segments]
        generatePackageModules (opts `upd` optDependencies := (++ deps)) info (allPackages info)
    return ()

-- | Gather information about classes via Reflection
-- or (depending on the options set) from a dump file.
gatherClassInfo
    :: Options
    -> Maybe FilePath
    -> [String]
    -> Java (Map String JavaClass)
gatherClassInfo opts reflectDump classNames = do

    reflectClasses <- getReflectClasses

    print ((\_ -> let { __ = 
{-# LINE 212 "Java2Haskell.hss" #-}
concat ["Gathering reflection information..."]
{-# LINE 212 "Java2Haskell.hss" #-}
} in __) undefined)
    let getClassInfo :: Java (Map String JavaClass)
        getClassInfo = everywhere (mkT (\(TyVar v) -> TyVar ('_':v)))
            `fmap` reflectClasses True classNames

        readClassInfo :: String -> Java (Map String JavaClass)
        readClassInfo file = io $ Strict.readFile file >>= return . read
            
    classInfo <- maybe getClassInfo (\f -> print " (from dump)" >> readClassInfo f) reflectDump
    println ((\_ -> let { __ = 
{-# LINE 221 "Java2Haskell.hss" #-}
concat [" Done (found ", (show $ Map.size classInfo), " classes)."]
{-# LINE 221 "Java2Haskell.hss" #-}
} in __) undefined)

    unless (null (opts `get` optSaveReflectDump)) $ io $ do
        file <- openFile (opts `get` optSaveReflectDump) WriteMode
        print ((\_ -> let { __ = 
{-# LINE 225 "Java2Haskell.hss" #-}
concat ["Saving dump of reflection info..."]
{-# LINE 225 "Java2Haskell.hss" #-}
} in __) undefined)
        hPutStr file (show classInfo)
        println " Done."
        hClose file

    return classInfo

-- This actually creates the Haskell module files for packages
generatePackageModules
    :: Options
    -> ClassInfo
    -> [String]
    -> Java ()
generatePackageModules opts info packages = do

    cwd <- io $ getCurrentDirectory
    print ((\_ -> let { __ = 
{-# LINE 241 "Java2Haskell.hss" #-}
concat ["Generating modules for ", (show $ length packages), " packages in ", (cwd), "..."]
{-# LINE 241 "Java2Haskell.hss" #-}
} in __) undefined)

    -- Create all the package files.
    -- These contain the Java classes as Haskell types.
    forM_ packages $ \packageName -> do
        let packageMod = info `packageModName` packageName
            dirName = strJoin [pathSeparator] (strSplitAll "." packageMod)

        -- Create the directory for the package
        io $ do 
            createDirectoryIfMissing True dirName

            -- Create the Haskell module file for the Java package
            file <- openFile (dirName ++ ".hs") WriteMode
            code <- gen info $ javaPackageModule packageName
            hPutStrLn file code
            hClose file

    when (opts `get` optCabalProject)
        $ writeCabalFile
            (opts `get` optProjectName)
            (opts `get` optProjectVersion)
            (opts `get` optCabalExtra)
            (opts `get` optDependencies)
            (map (info `packageModName`) packages)

    println " Done."


-- This actually creates the Haskell module files for classes
generateClassModules
    :: Options
    -> ClassInfo
    -> [String]
    -> Java ()
generateClassModules opts info classes = do

    cwd <- io $ getCurrentDirectory
    print ((\_ -> let { __ = 
{-# LINE 279 "Java2Haskell.hss" #-}
concat ["Generating modules for ", (show $ length classes), " classes in ", (cwd), "..."]
{-# LINE 279 "Java2Haskell.hss" #-}
} in __) undefined)

    -- Create all the class files.
    -- These contain the java methods as Haskell functions.
    forM_ classes $ \className -> do
        let fileName = strJoin [pathSeparator] (strSplitAll "." (info `classModName` className))
            dirName  = takeDirectory fileName

        io $ do
            createDirectoryIfMissing True dirName

            -- Create the Haskell module file for the Java class.
            file <- openFile (fileName ++ ".hs") WriteMode
            code <- gen info $ javaClassModule className
            hPutStrLn file code
            hClose file

            -- Create the interface Haskell module file for the Java class.
            file <- openFile (fileName ++ "__.hs") WriteMode
            code <- gen info $ javaClassModule' className
            hPutStrLn file code
            hClose file

    let modules = map (info `classModName`) classes
    when (opts `get` optCabalProject)
        $ writeCabalFile
            (opts `get` optProjectName)
            (opts `get` optProjectVersion)
            (opts `get` optCabalExtra)
            (opts `get` optDependencies)
            (modules ++ map (++ "__") modules)

    println " Done."


-- | Write a cabal project file. Can be used in any MonadIO, e.g. IO or Java or...
writeCabalFile :: MonadIO m =>
       String   -- project name
    -> String   -- project version
    -> String   -- extra 
    -> [String] -- dependencies
    -> [String] -- public module list
    -> m ()
writeCabalFile projectName projectVersion extra dependencies modules = liftIO $ do

    cabalFile <- openFile (projectName ++ ".cabal") WriteMode
    hPutStrLn cabalFile ((\_ -> let { __ = 
{-# LINE 325 "Java2Haskell.hss" #-}
concat ["name:           ", (projectName), "\nversion:        ", (projectVersion), "\ncabal-version:  >= 1.8\nbuild-type:     Simple\n", (extra), "\nLibrary\n build-depends:\n  base >= 4 && < 5", (concatMap (",\n  " ++) dependencies), "\n exposed-modules:\n  ", (strJoin ",\n  " modules), "\n"]
{-# LINE 337 "Java2Haskell.hss" #-}
} in __) undefined)
    hClose cabalFile