morloc-0.33.0: executable/Subcommands.hs

{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Subcommands
Description : Morloc executable subcommands
Copyright   : (c) Zebulun Arendsee, 2020
License     : GPL-3
Maintainer  : zbwrnz@gmail.com
Stability   : experimental
-}
module Subcommands
  ( getConfig
  , cmdInstall
  , cmdMake
  , cmdRemove
  , cmdTypecheck
  ) where

import Morloc.Namespace
import System.Console.Docopt
import qualified Morloc as M
import qualified Morloc.Config as Config
import qualified Morloc.Data.Text as MT
import qualified Morloc.Module as Mod
import qualified Morloc.Monad as MM
import qualified Morloc.Frontend.API as F

type Subcommand = Arguments -> Config.Config -> IO ()

getArgOrDie :: Arguments -> Option -> MT.Text
getArgOrDie args opt =
  case getArg args opt of
    Nothing -> error ("Invalid command: Expected option '" <> show opt)
    (Just x) -> MT.pack x

-- | read the global morloc config file or return a default one
getConfig :: Arguments -> IO Config.Config
getConfig args = do
  let givenPath = getArg args (longOption "config")
  let isVanilla = isPresent args (longOption "vanilla")
  defaultPath <- Config.getDefaultConfigFilepath
  let configPath =
        if isVanilla
          then Nothing
          else case givenPath of
                 (Just f) -> Just . Path . MT.pack $ f
                 Nothing -> Just defaultPath
  -- load the config file
  Config.loadMorlocConfig configPath

getVerbosity :: Arguments -> Int
getVerbosity args =
  if isPresent args (longOption "verbose")
    then 1
    else 0

-- | handle the code, either from a file or a raw string
readScript :: Arguments -> IO (Maybe Path, Code)
readScript args = do
  let input = getArgOrDie args (argument "script")
  if isPresent args (longOption "expression") 
  then do
    let code = Code input 
    return (Nothing, code)
  else do
    let filename = Path input
    code <- fmap Code $ MT.readFile (MT.unpack input)
    return (Just filename, code)

-- | install a module
cmdInstall :: Subcommand
cmdInstall args conf =
  (MM.runMorlocMonad (getVerbosity args) conf cmdInstall') >>= MM.writeMorlocReturn
  where
    cmdInstall' = do
      let name = getArgOrDie args (argument "name")
      if isPresent args (longOption "github")
        then Mod.installModule (Mod.GithubRepo name)
        else Mod.installModule (Mod.CoreGithubRepo name)

-- | remove a previously installed module (NOT YET IMPLEMENTED)
cmdRemove :: Subcommand
cmdRemove _ _ = do
  putStrLn "not removing anything"

-- | build a Morloc program, generating the nexus and pool files
cmdMake :: Subcommand
cmdMake args config = do
  (path, code) <- readScript args
  MM.runMorlocMonad (getVerbosity args) config (M.writeProgram path code) >>=
    MM.writeMorlocReturn

cmdTypecheck :: Subcommand
cmdTypecheck args config = do
  let expr = getArgOrDie args (argument "script")
  expr' <-
    if isPresent args (longOption "expression")
      then return expr
      else MT.readFile (MT.unpack expr)
  let base =
        if isPresent args (longOption "expression")
          then Nothing
          else Just (Path expr)
  let writer =
        if isPresent args (longOption "raw")
          then F.ugly
          else F.cute
  if isPresent args (longOption "type")
    then print $ F.readType expr'
    else MM.runMorlocMonad
           (getVerbosity args)
           config
           (M.typecheck base (Code expr') >>= MM.liftIO . writer) >>=
         MM.writeMorlocReturn