packages feed

morloc-0.33.0: library/Morloc/Module.hs

{-|
Module      : Module
Description : Morloc module imports and paths 
Copyright   : (c) Zebulun Arendsee, 2020
License     : GPL-3
Maintainer  : zbwrnz@gmail.com
Stability   : experimental
-}
module Morloc.Module
  ( ModuleSource(..)
  , installModule
  , findModule
  , loadModuleMetadata
  ) where

import Morloc.Namespace
import Morloc.Data.Doc
import qualified Morloc.Config as Config
import qualified Morloc.Data.Text as MT
import qualified Morloc.Monad as MM
import qualified Morloc.System as MS

import Data.Aeson (FromJSON(..), (.!=), (.:?), withObject)
import qualified Data.Yaml.Config as YC

instance FromJSON PackageMeta where
  parseJSON = withObject "object" $ \o ->
    PackageMeta <$> o .:? "name"        .!= ""
                <*> o .:? "version"     .!= ""
                <*> o .:? "homepage"    .!= ""
                <*> o .:? "synopsis"    .!= ""
                <*> o .:? "description" .!= ""
                <*> o .:? "category"    .!= ""
                <*> o .:? "license"     .!= ""
                <*> o .:? "author"      .!= ""
                <*> o .:? "maintainer"  .!= ""
                <*> o .:? "github"      .!= ""
                <*> o .:? "bug-reports" .!= ""
                <*> o .:? "gcc-flags"   .!= ""

-- | Specify where a module is located 
data ModuleSource
  = LocalModule (Maybe MT.Text)
  -- ^ A module in the working directory
  | GithubRepo MT.Text
  -- ^ A module stored in an arbitrary Github repo: "<username>/<reponame>"
  | CoreGithubRepo MT.Text
  -- ^ The repo name of a core package, e.g., "math"

-- | Look for a local morloc module.
findModule :: MVar -> MorlocMonad Path
findModule moduleName = do
  config <- MM.ask
  let lib = Config.configLibrary config
  let allPaths = getModulePaths lib moduleName
  existingPaths <- liftIO . fmap catMaybes . mapM getFile $ allPaths
  case existingPaths of
    (x:_) -> return x
    [] ->
      MM.throwError . CannotLoadModule . render $
        "module not found among the paths:" <+> list (map pretty allPaths)

-- | Give a module path (e.g. "/your/path/foo.loc") find the package metadata.
-- It currently only looks for a file named "package.yaml" in the same folder
-- as the main "*.loc" file. 
findModuleMetadata :: Path -> IO (Maybe Path)
findModuleMetadata mainFile =
  getFile $ MS.combine (MS.takeDirectory mainFile) (Path "package.yaml")

loadModuleMetadata :: Path -> MorlocMonad ()
loadModuleMetadata main = do
  maybef <- liftIO $ findModuleMetadata main
  meta <-
    case maybef of
      (Just f) -> liftIO $ YC.loadYamlSettings [MT.unpack . unPath $ f] [] YC.ignoreEnv
      Nothing -> return defaultPackageMeta
  state <- MM.get
  MM.put (appendMeta meta state)
  where
    appendMeta :: PackageMeta -> MorlocState -> MorlocState
    appendMeta m s = s {statePackageMeta = m : (statePackageMeta s)}

-- | Find an ordered list of possible locations to search for a module
getModulePaths :: Path -> MVar -> [Path]
getModulePaths (Path lib) (MVar base) = map Path
  [ base <> ".loc"                              -- "./${base}.loc"
  , base <> "/" <> "main.loc"                   -- "${base}/main.loc"
  , lib <> "/" <> base <> ".loc"                -- "${LIB}/${base}.loc"
  , lib <> "/" <> base <> "/" <> "main.loc"     -- "${LIB}/${base}/main.loc"
  , lib <> "/" <> base <> "/" <> base <> ".loc" -- "${LIB}/${base}/${base}.loc"
  ]

getFile :: Path -> IO (Maybe Path)
getFile x = do
  exists <- MS.fileExists x
  return $
    if exists
      then Just x
      else Nothing

-- | Attempt to clone a package from github
installGithubRepo ::
     MT.Text -- ^ the repo path ("<username>/<reponame>")
  -> MT.Text -- ^ the url for github (e.g., "https://github.com/")
  -> MorlocMonad ()
installGithubRepo repo url = do
  config <- MM.ask
  let (Path lib) = Config.configLibrary config
  let cmd = MT.unwords ["git clone", url, lib <> "/" <> repo]
  MM.runCommand "installGithubRepo" cmd

-- | Install a morloc module
installModule :: ModuleSource -> MorlocMonad ()
installModule (GithubRepo repo) =
  installGithubRepo repo ("https://github.com/" <> repo)
installModule (CoreGithubRepo name) =
  installGithubRepo name ("https://github.com/morloclib/" <> name)
installModule (LocalModule Nothing) =
  MM.throwError (NotImplemented "module installation from working directory")
installModule (LocalModule (Just _)) =
  MM.throwError (NotImplemented "module installation from local directory")