content: {-# LANGUAGE CPP #-}
  -- | Read and write JSMods.
  module Haste.Module (moduleFilePath, writeModule, readModule) where
  import Module (moduleNameSlashes, mkModuleName)
  import qualified Data.ByteString.Lazy as B
  import Control.Shell
  import Haste.AST
  import Data.Binary
  import Data.List (isSuffixOf)
  import qualified Data.ByteString.UTF8 as BS
  import qualified Haste.JSLib as JSLib
  import qualified System.IO as IO
  
  -- | The file extension to use for modules.
  jsmodExt :: Bool -> String
  jsmodExt boot = if boot then "jsmod-boot" else "jsmod"
  
  -- | Build the path to the jsmod file corresponding to the given module.
  moduleFilePath :: FilePath -- ^ Base path to look for module in.
                 -> String   -- ^ Module name; e.g. @Foo.Bar@
                 -> Bool     -- ^ Build name for a boot module?
                 -> FilePath
  moduleFilePath basepath modname boot =
    flip addExtension (jsmodExt boot) $
      basepath </> moduleNameSlashes (mkModuleName modname)
  
  -- | Write a module to file, with the extension specified in `fileExt`.
  --   Assuming that fileExt = "jsmod", a module Foo.Bar is written to
  --   @basepath/Foo/Bar.jsmod@.
  --
  --   If any directory in the path where the module is to be written doesn't
  --   exist, it gets created.
  --
  --   Boot modules and "normal" modules get merged at this stage.
  writeModule :: FilePath -> Module -> Bool -> IO ()
  writeModule basepath m@(Module _ modname _ _ _) boot =
    fromRight "writeModule" . shell $ do
      mkdir True (takeDirectory path)
      mcompanion <- readMod basepath modstr (not boot)
      m' <- case mcompanion of
              Just companion -> do
                when (isFile bootpath) $ rm bootpath
                return $ merge' m companion
              _              ->
                return m
      liftIO . B.writeFile path $ encode m'
    where
      modstr = BS.toString modname
      path = moduleFilePath basepath modstr boot
      bootpath = moduleFilePath basepath modstr True
      merge' = if boot then merge else flip merge
  
  -- | Read a module from file. If the module is not found at the specified path,
  --   libpath/path is tried instead. Returns Nothing is the module is not found
  --   on either path.
  --
  --   This function first looks for an appropriate jslib file. If none is
  --   found, then it looks for a standalone jsmod file, possibly with an
  --   accompanying jsmod-boot file. If neither is found, it concludes that
  --   the module simply does not exist on the given path and returns @Nothing@.
  readModule :: FilePath -> String -> String -> IO (Maybe Module)
  readModule basepath pkgid modname = fromRight "readModule" . shell $ do
    libfile <- (basepath </>) `fmap` jslibFileName basepath pkgid
    mmlib <- liftIO $ JSLib.readModule libfile modname
    mm <- readMod basepath modname False
    mmboot <- readMod basepath modname True
    case (mmlib, mm, mmboot) of
      (Just m, _, _)          -> return $ Just m
      (_, Just m, Nothing)    -> return $ Just m
      (_, Just m, Just mboot) -> return . Just $ merge mboot m
      _                       -> return Nothing
  
  -- | Get the file name for a given package identifier.
  jslibFileName :: FilePath -> String -> Shell FilePath
  jslibFileName basepath pkgid
    | pkgid `elem` specials = do
        dirs <- ls basepath
        case filter (and . zipWith (==) pkgid) dirs of
          (dir:_) -> do
            files <- ls (basepath </> dir)
            case filter (".jslib" `isSuffixOf`) files of
              (f:_) -> return $ dir </> f
              _     -> fail $ "Package " ++ pkgid ++ " has no jslib file!"
          _ -> do
            return stdname
    | otherwise = do
        mfile <- findLibFile [basepath]
        case mfile of
          Just f -> do
            -- Lib file was found directly in basepath
            return f
          _         -> do
            -- Lib file wasn't found directly in basepath, so let's try subdirs
            contents <- ls basepath
            let dirs = [basepath </> p | p <- contents, pkgid `isSuffixOf` p]
            dirs' <- filterM isDirectory dirs
            case dirs' of
              ds | not (null ds) -> maybe stdname id <$> findLibFile ds
                 | otherwise     -> return stdname
    where
      findLibFile (d:ds) = do
        fs <- map (d </>) . filter (libfilesuffix `isSuffixOf`) <$> ls d
        fs' <- filterM isFile fs
        case fs' of
          (f:_) -> return (Just f)
          _     -> findLibFile ds
      findLibFile _ = do
        return Nothing
  
      -- Use this for non-special packages
      stdname = pkgid </> "libHS" ++ pkgid <.> "jslib"
      -- These package ids are special and come without version number
      specials = ["ghc-prim", "base", "integer-gmp"]
      libfilesuffix = pkgid <.> "jslib"
  
  readMod :: FilePath -> String -> Bool -> Shell (Maybe Module)
  readMod basepath modname boot = do
      x <- isFile path
      let path' = if x then path else syspath
      isF <- isFile path'
      if isF
         then do
           liftIO $ IO.withFile path' IO.ReadMode $ \h -> do
             m <- decode <$> (B.hGet h . fromInteger =<< IO.hFileSize h)
             m `seq` return (Just m)
         else do
           return Nothing
    where
      path = moduleFilePath "." modname boot
      syspath = moduleFilePath basepath modname boot
  
  fromRight :: String -> IO (Either ExitReason b) -> IO b
  fromRight from m = do
    ex <- m
    case ex of
      Right x -> return x
      Left e  -> fail $ "shell expression failed in " ++ from ++ ": " ++
                        exitString e
  