diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# chromatin diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +import Neovim + +import Chromatin.Plugin (plugin) + +main :: IO () +main = neovim defaultConfig {plugins = [plugin]} diff --git a/chromatin.cabal b/chromatin.cabal new file mode 100644 --- /dev/null +++ b/chromatin.cabal @@ -0,0 +1,199 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 560b0a26d65a7e63d7c566631d1a3e83822116adb9958225a42bbb595604065f + +name: chromatin +version: 0.1.0.0 +synopsis: neovim package manager +description: Please see the README on GitHub at +category: Neovim +homepage: https://github.com/tek/chromatin-hs#readme +bug-reports: https://github.com/tek/chromatin-hs/issues +author: Torsten Schmits +maintainer: tek@tryp.io +copyright: 2018 Torsten Schmits +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/tek/chromatin-hs + +library + exposed-modules: + Chromatin.Config + Chromatin.Data.ActiveRplugin + Chromatin.Data.Chromatin + Chromatin.Data.Env + Chromatin.Data.InstallResult + Chromatin.Data.RebuildControl + Chromatin.Data.RebuildTask + Chromatin.Data.Rplugin + Chromatin.Data.RpluginConfig + Chromatin.Data.RpluginName + Chromatin.Data.Rplugins + Chromatin.Data.RpluginSource + Chromatin.Data.RpluginState + Chromatin.Data.RunBuiltResult + Chromatin.Data.RunExistingResult + Chromatin.Diag + Chromatin.Init + Chromatin.Log + Chromatin.Plugin + Chromatin.Rebuild + Chromatin.Rebuild.Build + Chromatin.Rebuild.Existing + Chromatin.Rebuild.Nonexisting + Chromatin.Run + Chromatin.Settings + Chromatin.Test.Config + Chromatin.Test.Unit + Chromatin.Unload + other-modules: + Paths_chromatin + hs-source-dirs: + lib + build-depends: + Glob + , base >=4.7 && <5 + , bytestring + , conduit + , containers + , data-default-class + , deepseq + , directory + , filepath + , hslogger + , lens + , messagepack + , nvim-hs + , parsec + , prettyprinter + , resourcet + , ribosome + , split + , stm-chans + , stm-conduit + , transformers + , typed-process + , unliftio + default-language: Haskell2010 + +executable chromatin + main-is: Main.hs + other-modules: + Paths_chromatin + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Glob + , base >=4.7 && <5 + , bytestring + , chromatin + , conduit + , containers + , data-default-class + , deepseq + , directory + , filepath + , hslogger + , lens + , messagepack + , nvim-hs + , parsec + , prettyprinter + , resourcet + , ribosome + , split + , stm-chans + , stm-conduit + , transformers + , typed-process + , unliftio + default-language: Haskell2010 + +test-suite chromatin-functional + type: exitcode-stdio-1.0 + main-is: SpecMain.hs + other-modules: + Paths_chromatin + hs-source-dirs: + test/f + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Glob + , HTF + , base >=4.7 && <5 + , bytestring + , chromatin + , conduit + , containers + , data-default-class + , deepseq + , directory + , filepath + , hslogger + , lens + , messagepack + , nvim-hs + , parsec + , prettyprinter + , resourcet + , ribosome + , split + , stm-chans + , stm-conduit + , transformers + , typed-process + , unliftio + default-language: Haskell2010 + +test-suite chromatin-unit + type: exitcode-stdio-1.0 + main-is: SpecMain.hs + other-modules: + BuildSpec + Config + ConfigSpec + DiagSpec + RebuildSpec + RunSpec + Paths_chromatin + hs-source-dirs: + test/u + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Glob + , HTF + , base >=4.7 && <5 + , bytestring + , chromatin + , conduit + , containers + , data-default-class + , deepseq + , directory + , filepath + , hslogger + , lens + , messagepack + , nvim-hs + , parsec + , prettyprinter + , resourcet + , ribosome + , split + , stm-chans + , stm-conduit + , transformers + , typed-process + , unliftio + default-language: Haskell2010 diff --git a/lib/Chromatin/Config.hs b/lib/Chromatin/Config.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Config.hs @@ -0,0 +1,95 @@ +module Chromatin.Config( + readConfig, + analyzeConfig, + RpluginModification(..), + analyzeConfigIO, +) where + +import Data.Maybe (fromMaybe) +import Data.Foldable (find) +import Text.ParserCombinators.Parsec +import System.FilePath (takeFileName) +import qualified Ribosome.Control.Ribo as Ribo (inspect) +import Ribosome.Config.Setting (setting) +import Chromatin.Data.Chromatin (Chromatin) +import qualified Chromatin.Data.Env as Env (rplugins) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginSource (RpluginSource(..), HackageDepspec(HackageDepspec), PypiDepspec(PypiDepspec)) +import Chromatin.Data.Rplugins (Rplugins(Rplugins)) +import Chromatin.Data.RpluginConfig (RpluginConfig(RpluginConfig)) +import qualified Chromatin.Settings as S (rplugins) + +readConfig :: Chromatin Rplugins +readConfig = setting S.rplugins + +data RpluginModification = + RpluginNew RpluginName RpluginSource + | + RpluginRemove Rplugin + | + RpluginUpdate Rplugin RpluginSource + | + RpluginKeep Rplugin + deriving (Eq, Show) + +data ParsedSpec = + PrefixedSpec String String + | + PlainSpec String + +parsePrefixed :: GenParser Char st ParsedSpec +parsePrefixed = do + prefix <- many $ noneOf ":" + _ <- char ':' + spec <- many anyChar + return $ PrefixedSpec prefix spec + +specParser :: GenParser Char st ParsedSpec +specParser = try parsePrefixed <|> fmap PlainSpec (many anyChar) + +parseSpec :: String -> Either ParseError ParsedSpec +parseSpec = parse specParser "none" + +sourceFromSpec :: String -> Either String RpluginSource +sourceFromSpec spec = + case parseSpec spec of + Right (PrefixedSpec prefix spec') -> case prefix of + "pip" -> Right $ Pypi (PypiDepspec spec') + "hackage" -> Right $ Hackage (HackageDepspec spec') + "stack" -> Right $ Stack spec' + a -> Left $ "unknown rplugin prefix `" ++ a ++ "` in `" ++ spec ++ "`" + Right (PlainSpec name') -> + Right $ Hackage (HackageDepspec name') + Left _ -> Left $ "failed to parse `" ++ spec ++ "`" + +rpluginHasName :: RpluginName -> Rplugin -> Bool +rpluginHasName target (Rplugin name _) = target == name + +nameFromSource :: RpluginSource -> RpluginName +nameFromSource (Hackage (HackageDepspec n)) = RpluginName n +nameFromSource (Stack fp) = RpluginName (takeFileName fp) +nameFromSource (Pypi (PypiDepspec n)) = RpluginName n + +modifyExisting :: RpluginSource -> Rplugin -> RpluginModification +modifyExisting _ _ = undefined + +modification :: [Rplugin] -> RpluginConfig -> Either String RpluginModification +modification current (RpluginConfig spec explicitName) = do + source <- sourceFromSpec spec + let name = fromMaybe (nameFromSource source) explicitName + let sameName = find (rpluginHasName name) current + return $ maybe (RpluginNew name source) (modifyExisting source) sameName + +removals :: [RpluginModification] -> [RpluginModification] +removals _ = [] + +analyzeConfig :: [Rplugin] -> Rplugins -> Either String [RpluginModification] +analyzeConfig current (Rplugins rplugins) = do + let mods = traverse (modification current) rplugins + fmap (\m -> m ++ removals m) mods + +analyzeConfigIO :: Rplugins -> Chromatin (Either String [RpluginModification]) +analyzeConfigIO rplugins = do + current <- Ribo.inspect Env.rplugins + return $ analyzeConfig current rplugins diff --git a/lib/Chromatin/Data/ActiveRplugin.hs b/lib/Chromatin/Data/ActiveRplugin.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/ActiveRplugin.hs @@ -0,0 +1,12 @@ +module Chromatin.Data.ActiveRplugin( + ActiveRplugin(..), +) where + +import Chromatin.Data.Rplugin (Rplugin) + +data ActiveRplugin = + ActiveRplugin { + arChannelId :: Int, + arRplugin :: Rplugin + } + deriving (Show, Eq) diff --git a/lib/Chromatin/Data/Chromatin.hs b/lib/Chromatin/Data/Chromatin.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/Chromatin.hs @@ -0,0 +1,9 @@ +module Chromatin.Data.Chromatin( + Chromatin, +) where + +import UnliftIO.STM (TVar) +import Ribosome.Control.Ribo (Ribo) +import Chromatin.Data.Env (Env) + +type Chromatin a = Ribo (TVar Env) a diff --git a/lib/Chromatin/Data/Env.hs b/lib/Chromatin/Data/Env.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/Env.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Chromatin.Data.Env( + Env(..), + _rplugins, + _errors, + _installerChan, +) where + +import Control.Concurrent.STM.TBMChan (TBMChan) +import Control.Lens (makeClassy_) +import Data.Default.Class (Default(def)) +import Ribosome.Data.Errors (Errors) +import Chromatin.Data.Rplugin (Rplugin) +import Chromatin.Data.RebuildControl (RebuildControl) + +data Env = + Env { + rplugins :: [Rplugin], + errors :: Errors, + installerChan :: Maybe (TBMChan RebuildControl) + } + +makeClassy_ ''Env + +instance Default Env where + def = Env def def def diff --git a/lib/Chromatin/Data/InstallResult.hs b/lib/Chromatin/Data/InstallResult.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/InstallResult.hs @@ -0,0 +1,14 @@ +module Chromatin.Data.InstallResult( + InstallResult(..), +) where + +import Chromatin.Data.Rplugin (Rplugin) +import Chromatin.Data.RebuildTask (RebuildTask) + +data InstallResult = + Success Rplugin + | + Failure RebuildTask + | + PreviousFailure String RebuildTask + deriving Show diff --git a/lib/Chromatin/Data/RebuildControl.hs b/lib/Chromatin/Data/RebuildControl.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RebuildControl.hs @@ -0,0 +1,11 @@ +module Chromatin.Data.RebuildControl( + RebuildControl(..), +) where + +import Chromatin.Data.RebuildTask (RebuildTask) + +data RebuildControl = + Continue RebuildTask + | + Stop + deriving Show diff --git a/lib/Chromatin/Data/RebuildTask.hs b/lib/Chromatin/Data/RebuildTask.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RebuildTask.hs @@ -0,0 +1,10 @@ +module Chromatin.Data.RebuildTask( + RebuildTask(..), +) where + +import Chromatin.Data.RpluginName (RpluginName) +import Chromatin.Data.RpluginSource (RpluginSource) + +data RebuildTask = + RebuildTask RpluginName RpluginSource + deriving Show diff --git a/lib/Chromatin/Data/Rplugin.hs b/lib/Chromatin/Data/Rplugin.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/Rplugin.hs @@ -0,0 +1,13 @@ +module Chromatin.Data.Rplugin( + Rplugin(..), +) where + +import Chromatin.Data.RpluginName (RpluginName) +import Chromatin.Data.RpluginSource (RpluginSource) + +data Rplugin = + Rplugin { + name :: RpluginName, + source :: RpluginSource + } + deriving (Show, Eq) diff --git a/lib/Chromatin/Data/RpluginConfig.hs b/lib/Chromatin/Data/RpluginConfig.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RpluginConfig.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Chromatin.Data.RpluginConfig( + RpluginConfig(..), +) where + +import GHC.Generics (Generic) +import qualified Data.Map as Map (fromList) +import Data.Text.Prettyprint.Doc ((<+>), viaShow) +import Control.DeepSeq (NFData) +import Neovim (NvimObject(..), Dictionary, Object(ObjectMap)) +import Ribosome.Internal.NvimObject (extractObject) +import Chromatin.Data.RpluginName (RpluginName) + +data RpluginConfig = + RpluginConfig { + rpluginConfigSpec :: String, + rpluginConfigName :: Maybe RpluginName + } + deriving (Show, Generic, NFData) + +instance NvimObject RpluginConfig where + toObject RpluginConfig {..} = + (toObject :: Dictionary -> Object) . Map.fromList $ + [ + ("spec", toObject rpluginConfigSpec), + ("name", toObject rpluginConfigName) + ] + fromObject (ObjectMap o) = do + spec' <- extractObject "spec" o + name' <- extractObject "name" o + return $ RpluginConfig spec' name' + fromObject o = Left ("invalid type for RpluginConfig: " <+> viaShow o) diff --git a/lib/Chromatin/Data/RpluginName.hs b/lib/Chromatin/Data/RpluginName.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RpluginName.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Chromatin.Data.RpluginName( + RpluginName(..), +) where + +import GHC.Generics (Generic) +import Control.DeepSeq (NFData) +import Neovim.Classes (NvimObject(..)) +import Ribosome.Internal.NvimObject (deriveString) + +newtype RpluginName = RpluginName String + deriving (Eq, Show, Generic, NFData) + +instance NvimObject RpluginName where + toObject (RpluginName s) = toObject s + fromObject = deriveString RpluginName diff --git a/lib/Chromatin/Data/RpluginSource.hs b/lib/Chromatin/Data/RpluginSource.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RpluginSource.hs @@ -0,0 +1,27 @@ +module Chromatin.Data.RpluginSource( + HackageDepspec(..), + PypiDepspec(..), + RpluginSource(..), +) where + +newtype HackageDepspec = + HackageDepspec String + deriving (Show, Eq) + +newtype PypiDepspec = + PypiDepspec String + deriving (Show, Eq) + +data RpluginSource = + Hackage { + hackageSpec :: HackageDepspec + } + | + Stack { + stackProject :: FilePath + } + | + Pypi { + pypiSpec :: PypiDepspec + } + deriving (Show, Eq) diff --git a/lib/Chromatin/Data/RpluginState.hs b/lib/Chromatin/Data/RpluginState.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RpluginState.hs @@ -0,0 +1,11 @@ +module Chromatin.Data.RpluginState( + RpluginState(..), +) where + +data RpluginState = + Broken String + | + Ready + | + Incomplete + deriving Show diff --git a/lib/Chromatin/Data/Rplugins.hs b/lib/Chromatin/Data/Rplugins.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/Rplugins.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Chromatin.Data.Rplugins( + Rplugins(..), +) where + +import GHC.Generics (Generic) +import Data.Default.Class (Default) +import Control.DeepSeq (NFData) +import Neovim.Classes (NvimObject(..)) +import Chromatin.Data.RpluginConfig (RpluginConfig) + +newtype Rplugins = + Rplugins [RpluginConfig] + deriving (Generic, NFData, Default) + +instance NvimObject Rplugins where + toObject (Rplugins cs) = toObject cs + fromObject o = fmap Rplugins (fromObject o) diff --git a/lib/Chromatin/Data/RunBuiltResult.hs b/lib/Chromatin/Data/RunBuiltResult.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RunBuiltResult.hs @@ -0,0 +1,21 @@ +module Chromatin.Data.RunBuiltResult( + RunBuiltResult(..), +) where + +import Chromatin.Data.ActiveRplugin (ActiveRplugin) +import Chromatin.Data.RebuildTask (RebuildTask) + +data RunBuiltResult = + Success ActiveRplugin + | + Failure { + task :: RebuildTask, + errors :: [String] + } + | + PreviousFailure { + stage :: String, + task :: RebuildTask, + errors :: [String] + } + deriving Show diff --git a/lib/Chromatin/Data/RunExistingResult.hs b/lib/Chromatin/Data/RunExistingResult.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Data/RunExistingResult.hs @@ -0,0 +1,14 @@ +module Chromatin.Data.RunExistingResult( + RunExistingResult(..), +) where + +import Chromatin.Data.ActiveRplugin (ActiveRplugin) +import Chromatin.Data.RebuildTask (RebuildTask) + +data RunExistingResult = + Success ActiveRplugin + | + Failure RebuildTask [String] + | + NotReady RebuildTask + deriving Show diff --git a/lib/Chromatin/Diag.hs b/lib/Chromatin/Diag.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Diag.hs @@ -0,0 +1,17 @@ +module Chromatin.Diag( + crmDiag, +) where + +import Data.Functor (void) +import Neovim (CommandArguments) +import Ribosome.Data.ScratchOptions (defaultScratchOptions) +import Ribosome.Scratch (showInScratch) +import Chromatin.Data.Chromatin (Chromatin) + +diagnostics :: Chromatin [String] +diagnostics = return ["Diagnostics", ""] + +crmDiag :: CommandArguments -> Chromatin () +crmDiag _ = do + content <- diagnostics + void $ showInScratch content (defaultScratchOptions "chromatin-diagnostics") diff --git a/lib/Chromatin/Init.hs b/lib/Chromatin/Init.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Init.hs @@ -0,0 +1,26 @@ +module Chromatin.Init( + initialize, +) where + +import Data.Default.Class (Default(def)) +import System.Log.Logger (updateGlobalLogger, setLevel, Priority(ERROR)) +import Control.Monad.IO.Class (liftIO) +import UnliftIO.STM (TVar) +import Neovim (Neovim) +import Neovim.Context.Internal (Config(customConfig), asks') +import Ribosome.Control.Ribosome (newRibosome, Ribosome) +import Ribosome.Internal.IO (retypeNeovim) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Env (Env) +import Chromatin.Rebuild (crmRebuild) + +initialize' :: Chromatin (Ribosome (TVar Env)) +initialize' = do + crmRebuild def + asks' customConfig + +initialize :: Neovim e (Ribosome (TVar Env)) +initialize = do + liftIO $ updateGlobalLogger "Neovim.Plugin" (setLevel ERROR) + ribo <- newRibosome "chromatin" def + retypeNeovim (const ribo) initialize' diff --git a/lib/Chromatin/Log.hs b/lib/Chromatin/Log.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Log.hs @@ -0,0 +1,22 @@ +module Chromatin.Log( + debug, + info, + debugS, + infoS, + R.p, +) where + +import Ribosome.Control.Ribo (Ribo) +import qualified Ribosome.Log as R (debug, info, p) + +debug :: String -> Ribo e () +debug = R.debug "chromatin" + +info :: String -> Ribo e () +info = R.info "chromatin" + +debugS :: Show a => a -> Ribo e () +debugS = R.debug "chromatin" + +infoS :: Show a => a -> Ribo e () +infoS = R.info "chromatin" diff --git a/lib/Chromatin/Plugin.hs b/lib/Chromatin/Plugin.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Plugin.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Chromatin.Plugin( + plugin, +) +where + +import UnliftIO.STM (TVar) +import Neovim ( + Plugin(..), + command', + Neovim, + StartupConfig, + NeovimConfig, + NeovimPlugin, + wrapPlugin, + ) +import Ribosome.Control.Ribosome (Ribosome) +import Chromatin.Init (initialize) +import Chromatin.Data.Env (Env) +import Chromatin.Diag (crmDiag) +import Chromatin.Rebuild (crmRebuild) + +plugin' :: Ribosome (TVar Env) -> Plugin (Ribosome (TVar Env)) +plugin' env = + Plugin { + environment = env, + exports = [ + $(command' 'crmDiag) [], + $(command' 'crmRebuild) [] + ] + } + +plugin :: Neovim (StartupConfig NeovimConfig) NeovimPlugin +plugin = do + env <- initialize + wrapPlugin $ plugin' env diff --git a/lib/Chromatin/Rebuild.hs b/lib/Chromatin/Rebuild.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Rebuild.hs @@ -0,0 +1,121 @@ +module Chromatin.Rebuild( + crmRebuild, +) where + +import Conduit (ConduitT, (.|), runConduit, mapMC, sinkList, await, yield) +import Control.Concurrent.STM.TBMChan (TBMChan, newTBMChan, writeTBMChan, closeTBMChan) +import qualified Control.Lens as Lens (set) +import Control.Monad.Trans.Class (lift) +import Data.Conduit.TMChan (sourceTBMChan) +import Data.Foldable (traverse_) +import Data.Functor (void) +import Data.Void (Void) +import UnliftIO (atomically) +import UnliftIO.STM (TVar, STM) +import Neovim (CommandArguments) +import Ribosome.Control.Ribo (Ribo) +import qualified Ribosome.Control.Ribo as Ribo (inspect, modify) +import Ribosome.Data.ScratchOptions (defaultScratchOptions) +import Ribosome.Internal.IO (forkNeovim) +import Ribosome.Scratch (showInScratch) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Env (Env) +import qualified Chromatin.Data.Env as Env (installerChan, _installerChan) +import Chromatin.Data.RebuildTask (RebuildTask(..)) +import Chromatin.Data.RebuildControl (RebuildControl) +import qualified Chromatin.Data.RebuildControl as RebuildControl (RebuildControl(..)) +import Chromatin.Data.RunExistingResult (RunExistingResult) +import Chromatin.Data.RunBuiltResult (RunBuiltResult) +import qualified Chromatin.Data.RunBuiltResult as RunBuiltResult (RunBuiltResult(..)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginSource (RpluginSource) +import Chromatin.Config (readConfig, analyzeConfigIO, RpluginModification(RpluginNew)) +import Chromatin.Rebuild.Existing (handleExisting) +import Chromatin.Rebuild.Nonexisting (handleNonexisting) +import qualified Chromatin.Log as Log + +mapMChan :: Chromatin a -> (TBMChan RebuildControl -> Chromatin a) -> Chromatin a +mapMChan fEmpty f = do + storedChan <- Ribo.inspect Env.installerChan + maybe fEmpty f storedChan + +stopRebuilder :: Chromatin () +stopRebuilder = + mapMChan (return ()) $ \c -> do + Ribo.modify $ Lens.set Env._installerChan Nothing + atomically $ closeTBMChan c + Log.debug "stopped installer conduit" + +createChan :: STM (TBMChan RebuildControl) +createChan = newTBMChan 64 + +extractFailure :: RunBuiltResult -> [String] +extractFailure (RunBuiltResult.Failure (RebuildTask (RpluginName name) _) err) = + ("error when runnning plugin `" ++ name ++ "`:") : err +extractFailure (RunBuiltResult.Success _) = [] +extractFailure (RunBuiltResult.PreviousFailure stage (RebuildTask (RpluginName name) _) err) = + ("error in stage `" ++ stage ++ "` for plugin `" ++ name ++ "`:") : err + +controlC :: ConduitT RebuildControl RebuildTask (Ribo (TVar Env)) () +controlC = do + ctrl <- await + case ctrl of + Just RebuildControl.Stop -> lift stopRebuilder + Just (RebuildControl.Continue task) -> yield task >> controlC + Nothing -> controlC + +handleExistingC :: ConduitT RebuildTask RunExistingResult (Ribo (TVar Env)) () +handleExistingC = mapMC handleExisting + +handleNonexistingC :: ConduitT RunExistingResult RunBuiltResult (Ribo (TVar Env)) () +handleNonexistingC = mapMC handleNonexisting + +rebuilder :: TBMChan RebuildControl -> ConduitT () Void (Ribo (TVar Env)) [RunBuiltResult] +rebuilder chan = sourceTBMChan chan + .| controlC + .| handleExistingC + .| handleNonexistingC + .| sinkList + +runRebuilder :: TBMChan RebuildControl -> Chromatin () +runRebuilder chan = do + result <- runConduit $ rebuilder chan + case concatMap extractFailure result of + err@(_:_) -> void $ showInScratch err (defaultScratchOptions "chromatin-rebuild-error") + _ -> return () + Log.debug $ "installer terminated: " ++ show result + +forkRebuilder :: Chromatin (TBMChan RebuildControl) +forkRebuilder = do + chan <- atomically createChan + Ribo.modify $ Lens.set Env._installerChan (Just chan) + forkNeovim $ runRebuilder chan + return chan + +enqueue :: RebuildControl -> TBMChan RebuildControl -> Chromatin () +enqueue ctrl chan = atomically $ writeTBMChan chan ctrl + +executeRpluginNew :: RpluginName -> RpluginSource -> Chromatin () +executeRpluginNew name source = do + chan <- mapMChan forkRebuilder return + enqueue (RebuildControl.Continue (RebuildTask name source)) chan + +executeModification :: RpluginModification -> Chromatin () +executeModification (RpluginNew name source) = executeRpluginNew name source +executeModification _ = return () + +executeModifications :: [RpluginModification] -> Chromatin () +executeModifications mods = do + traverse_ executeModification mods + mapMChan (return ()) (enqueue RebuildControl.Stop) + +analysisError :: String -> Chromatin () +analysisError _ = return () + +crmRebuild :: CommandArguments -> Chromatin () +crmRebuild _ = do + config <- readConfig + analysis <- analyzeConfigIO config + case analysis of + Right mods -> executeModifications mods + Left e -> analysisError e diff --git a/lib/Chromatin/Rebuild/Build.hs b/lib/Chromatin/Rebuild/Build.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Rebuild/Build.hs @@ -0,0 +1,124 @@ +module Chromatin.Rebuild.Build( + installRplugin, + InstallResult(..), + venvDir, +) where + +import Control.Monad.IO.Class (MonadIO) +import Data.List.Split (linesBy) +import GHC.IO.Exception (ExitCode(ExitFailure)) +import GHC.IO.Handle.Types (Handle) +import qualified Data.ByteString.Lazy.Internal as B (unpackChars) +import System.FilePath (()) +import System.Process.Typed (ProcessConfig, setStdout, useHandleClose, readProcessStderr, proc, setWorkingDir) +import UnliftIO.Temporary (withSystemTempFile) +import UnliftIO.Directory ( + getXdgDirectory, + XdgDirectory(XdgData, XdgCache), + createDirectoryIfMissing, + removePathForcibly, + ) +import Neovim (Buffer, vim_command', vim_get_current_buffer', vim_command, buffer_get_number') +import Ribosome.Api.Echo (echom) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName(..)) +import Chromatin.Data.RpluginSource (RpluginSource(Hackage, Stack, Pypi), HackageDepspec(..), PypiDepspec(..)) +import Chromatin.Data.Chromatin (Chromatin) + +data InstallResult = + Success Rplugin + | + Failure [String] + deriving (Show, Eq) + +tailInTerminal :: FilePath -> Chromatin Buffer +tailInTerminal path = do + vim_command' $ "15split term://tail -f " ++ path + vim_get_current_buffer' + +closeTerminal :: Buffer -> Chromatin () +closeTerminal buf = do + num <- buffer_get_number' buf + _ <- vim_command $ "silent! " ++ show num ++ "bwipeout!" + return () + +processWithStdoutFile :: MonadIO m => ProcessConfig stdin stdout stderr -> Handle -> m (Either String ()) +processWithStdoutFile processConfig logHandle = do + let pipe = setStdout (useHandleClose logHandle) + (code, err) <- readProcessStderr $ pipe processConfig + return $ case code of + ExitFailure _ -> Left (B.unpackChars err) + _ -> Right () + +hackageProcess :: FilePath -> HackageDepspec -> ProcessConfig () () () +hackageProcess bindir (HackageDepspec spec) = + proc "cabal" ["new-install", "--symlink-bindir", bindir, spec] + +stackProcess :: FilePath -> ProcessConfig () () () +stackProcess path = + setWorkingDir path $ proc "stack" ["build"] + +processWithLog :: RpluginName -> ProcessConfig stdin stdout sderr -> Chromatin (Either String ()) +processWithLog (RpluginName name) processConfig = + withSystemTempFile "test-chromatin" $ \logFile logHandle -> do + buf <- tailInTerminal logFile + result <- processWithStdoutFile processConfig logHandle + case result of + Right _ -> do + echom $ "installed `" ++ name ++ "`" + closeTerminal buf + Left _ -> echom $ "failed to install `" ++ name ++ "`" + return result + +installHackageProcess :: RpluginName -> FilePath -> HackageDepspec -> Chromatin (Either String ()) +installHackageProcess name bindir spec = + processWithLog name $ hackageProcess bindir spec + +installStackProcess :: RpluginName -> FilePath -> Chromatin (Either String ()) +installStackProcess name path = + processWithLog name $ stackProcess path + +venvProcess :: FilePath -> ProcessConfig () () () +venvProcess dir = + proc "python3" ["-m", "venv", dir, "--upgrade"] + +venvDir :: RpluginName -> Chromatin FilePath +venvDir (RpluginName name) = getXdgDirectory XdgCache ("chromatin-hs" "venvs" name) + +createVenvProcess :: RpluginName -> Chromatin (Either String FilePath) +createVenvProcess name = do + dir <- venvDir name + removePathForcibly dir + r <- processWithLog name (venvProcess dir) + return $ dir <$ r + +pipProcess :: PypiDepspec -> FilePath -> ProcessConfig () () () +pipProcess (PypiDepspec spec) venv = + proc (venv "bin" "pip") ["install", "--no-cache", "--upgrade", spec] + +installPypiProcess :: RpluginName -> PypiDepspec -> FilePath -> Chromatin (Either String ()) +installPypiProcess name spec venv = + processWithLog name (pipProcess spec venv) + +binaryDir :: Chromatin FilePath +binaryDir = getXdgDirectory XdgData ("chromatin" "bin") + +installRpluginFromSource :: RpluginName -> RpluginSource -> Chromatin (Either String ()) +installRpluginFromSource name (Hackage spec) = do + bindir <- binaryDir + createDirectoryIfMissing True bindir + installHackageProcess name bindir spec +installRpluginFromSource name (Stack path) = + installStackProcess name path +installRpluginFromSource name (Pypi spec) = do + dir <- createVenvProcess name + case dir of + Right d -> installPypiProcess name spec d + Left e -> return $ Left e + +installRplugin :: RpluginName -> RpluginSource -> Chromatin InstallResult +installRplugin name source = do + result <- installRpluginFromSource name source + return $ case result of + Right _ -> Success $ Rplugin name source + Left err -> Failure $ linesBy (=='\n') err diff --git a/lib/Chromatin/Rebuild/Existing.hs b/lib/Chromatin/Rebuild/Existing.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Rebuild/Existing.hs @@ -0,0 +1,56 @@ +module Chromatin.Rebuild.Existing( + handleExisting, +) where + +import GHC.IO.Exception (IOException) +import qualified Data.ByteString.Lazy.Internal as B (unpackChars) +import Data.List.Split (linesBy) +import System.Process.Typed (readProcessStderr, proc, setWorkingDir) +import UnliftIO (tryIO) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.RebuildTask (RebuildTask(..)) +import Chromatin.Data.RunExistingResult (RunExistingResult) +import qualified Chromatin.Data.RunExistingResult as RunExistingResult (RunExistingResult(..)) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName) +import Chromatin.Data.RpluginSource (RpluginSource(Stack, Pypi)) +import Chromatin.Data.RpluginState (RpluginState) +import qualified Chromatin.Data.RpluginState as RpluginState (RpluginState(..)) +import Chromatin.Run (runRplugin, RunRpluginResult, pypiPluginPackage) +import qualified Chromatin.Run as RunRpluginResult (RunRpluginResult(..)) + +runPreexistingResult :: RebuildTask -> RunRpluginResult -> RunExistingResult +runPreexistingResult _ (RunRpluginResult.Success active) = RunExistingResult.Success active +runPreexistingResult task (RunRpluginResult.Failure err) = RunExistingResult.Failure task err + +unsafeStackDryRun :: FilePath -> Chromatin [String] +unsafeStackDryRun path = do + (_, output) <- readProcessStderr $ setWorkingDir path $ proc "stack" ["build", "--dry-run"] + return $ linesBy (=='\n') $ B.unpackChars output + +stackDryRun :: FilePath -> Chromatin (Either IOException [String]) +stackDryRun path = + tryIO $ unsafeStackDryRun path + +rpluginReady :: RpluginName -> RpluginSource -> Chromatin RpluginState +rpluginReady _ (Stack path) = do + output <- stackDryRun path + return $ case output of + Right lines' -> if "Would build:" `elem` lines' then RpluginState.Incomplete else RpluginState.Ready + Left err -> RpluginState.Broken $ "could not execute `stack build` in " ++ path ++ ": " ++ show err +rpluginReady name (Pypi _) = do + package <- pypiPluginPackage name + return $ maybe RpluginState.Incomplete (const RpluginState.Ready) package +rpluginReady _ _ = return $ RpluginState.Broken "NI" + +runPreexisting :: RebuildTask -> Chromatin RunExistingResult +runPreexisting task@(RebuildTask name source) = + runPreexistingResult task <$> runRplugin (Rplugin name source) + +handleExisting :: RebuildTask -> Chromatin RunExistingResult +handleExisting task@(RebuildTask name source) = do + state <- rpluginReady name source + case state of + RpluginState.Ready -> runPreexisting task + RpluginState.Incomplete -> return $ RunExistingResult.NotReady task + RpluginState.Broken reason -> return $ RunExistingResult.Failure task [reason] diff --git a/lib/Chromatin/Rebuild/Nonexisting.hs b/lib/Chromatin/Rebuild/Nonexisting.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Rebuild/Nonexisting.hs @@ -0,0 +1,35 @@ +module Chromatin.Rebuild.Nonexisting( + handleNonexisting, +) where + +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Rplugin (Rplugin) +import Chromatin.Data.RunExistingResult (RunExistingResult) +import qualified Chromatin.Data.RunExistingResult as RunExistingResult (RunExistingResult(..)) +import Chromatin.Data.RunBuiltResult (RunBuiltResult) +import qualified Chromatin.Data.RunBuiltResult as RunBuiltResult (RunBuiltResult(..)) +import Chromatin.Data.RebuildTask (RebuildTask(..)) +import Chromatin.Rebuild.Build (InstallResult, installRplugin) +import qualified Chromatin.Rebuild.Build as InstallResult (InstallResult(Success, Failure)) +import Chromatin.Run (runRplugin, RunRpluginResult) +import qualified Chromatin.Run as RunRpluginResult (RunRpluginResult(..)) + +runBuiltResult :: RebuildTask -> RunRpluginResult -> RunBuiltResult +runBuiltResult _ (RunRpluginResult.Success active) = RunBuiltResult.Success active +runBuiltResult task (RunRpluginResult.Failure err) = RunBuiltResult.Failure task err + +installSuccess :: RebuildTask -> Rplugin -> Chromatin RunBuiltResult +installSuccess task rplugin = + fmap (runBuiltResult task) (runRplugin rplugin) + +installResult :: RebuildTask -> InstallResult -> Chromatin RunBuiltResult +installResult task (InstallResult.Success rplugin) = installSuccess task rplugin +installResult task (InstallResult.Failure err) = return $ RunBuiltResult.Failure task err + +handleNonexisting :: RunExistingResult -> Chromatin RunBuiltResult +handleNonexisting (RunExistingResult.Success active) = return $ RunBuiltResult.Success active +handleNonexisting (RunExistingResult.Failure task err) = + return $ RunBuiltResult.PreviousFailure "run-existing" task err +handleNonexisting (RunExistingResult.NotReady task@(RebuildTask name source)) = do + result <- installRplugin name source + installResult task result diff --git a/lib/Chromatin/Run.hs b/lib/Chromatin/Run.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Run.hs @@ -0,0 +1,87 @@ +module Chromatin.Run( + runRplugin, + RunRpluginResult(..), + pypiPluginPackage, +) where + +import Control.Monad.IO.Class (liftIO) +import Data.List.Split (linesBy) +import Data.MessagePack (Object) +import UnliftIO.Exception (catch) +import System.FilePath (()) +import qualified System.FilePath.Glob as Glob (globDir1, compile) +import Neovim (NeovimException, toObject, fromObject', vim_call_function') +import qualified Neovim as NeovimException (NeovimException(ErrorMessage, ErrorResult)) +import qualified Data.Map as Map (fromList) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.ActiveRplugin (ActiveRplugin(ActiveRplugin)) +import Chromatin.Data.RpluginSource (RpluginSource(Stack, Pypi)) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Rebuild.Build (venvDir) + +data RunRpluginResult = + Success ActiveRplugin + | + Failure [String] + deriving (Show, Eq) + +jobstartFailure :: NeovimException -> Either String a +jobstartFailure (NeovimException.ErrorMessage doc) = Left (show doc) +jobstartFailure (NeovimException.ErrorResult obj) = Left (show obj) + +unsafeJobstart :: [Object] -> Chromatin Int +unsafeJobstart args = do + result <- vim_call_function' "jobstart" args + fromObject' result + +jobstart :: [Object] -> Chromatin (Either String Int) +jobstart args = + catch (Right <$> unsafeJobstart args) (return . jobstartFailure) + +runRpluginStack :: RpluginName -> FilePath -> Chromatin (Either String Int) +runRpluginStack (RpluginName name) path = do + let opts = Map.fromList [("cwd", toObject path), ("rpc", toObject True)] + jobstart [toObject $ "stack exec " ++ name, toObject opts] + +pypiPluginExecutable :: RpluginName -> Chromatin FilePath +pypiPluginExecutable name = do + dir <- venvDir name + return $ dir "bin" "ribosome_start_plugin" + +pypiSiteDir :: RpluginName -> Chromatin (Maybe FilePath) +pypiSiteDir name = do + venv <- venvDir name + matches <- liftIO $ Glob.globDir1 (Glob.compile "python3.?") (venv "lib") + return $ case matches of + dir : _ -> Just $ dir "site-packages" + _ -> Nothing + +pypiPluginPackage :: RpluginName -> Chromatin (Maybe FilePath) +pypiPluginPackage rpluginName@(RpluginName name) = do + dir <- pypiSiteDir rpluginName + return $ fmap ( name) dir + +runRpluginPypi :: RpluginName -> Chromatin (Either String Int) +runRpluginPypi rpluginName@(RpluginName name) = do + dir <- venvDir rpluginName + let exe = dir "bin" "python" + let opts = Map.fromList [("rpc", toObject True)] + start <- pypiPluginExecutable rpluginName + mayPackage <- pypiPluginPackage rpluginName + case mayPackage of + Just package -> + jobstart [toObject [toObject exe, toObject start, toObject package], toObject opts] + Nothing -> return $ Left $ "no `lib/python` directory in virtualenv for `" ++ name ++ "`" + +runRplugin' :: RpluginName -> RpluginSource -> Chromatin (Either String Int) +runRplugin' name (Stack path) = runRpluginStack name path +runRplugin' name (Pypi _) = runRpluginPypi name +runRplugin' _ _ = return (Left "NI") + +runRplugin :: Rplugin -> Chromatin RunRpluginResult +runRplugin rplugin@(Rplugin name source) = do + result <- runRplugin' name source + return $ case result of + Right channelId -> Success (ActiveRplugin channelId rplugin) + Left err -> Failure (linesBy (=='\n') err) diff --git a/lib/Chromatin/Settings.hs b/lib/Chromatin/Settings.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Settings.hs @@ -0,0 +1,10 @@ +module Chromatin.Settings( + rplugins, +) where + +import Data.Default.Class (Default(def)) +import Ribosome.Config.Setting +import Chromatin.Data.Rplugins (Rplugins) + +rplugins :: Setting Rplugins +rplugins = Setting "rplugins" True (Just def) diff --git a/lib/Chromatin/Test/Config.hs b/lib/Chromatin/Test/Config.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Test/Config.hs @@ -0,0 +1,13 @@ +module Chromatin.Test.Config( + defaultTestConfigWith, + defaultTestConfig, +) where + +import Ribosome.Test.Embed (TestConfig, Vars) +import qualified Ribosome.Test.Embed as E (defaultTestConfig, defaultTestConfigWith) + +defaultTestConfigWith :: Vars -> TestConfig +defaultTestConfigWith = E.defaultTestConfigWith "chromatin" + +defaultTestConfig :: TestConfig +defaultTestConfig = E.defaultTestConfig "chromatin" diff --git a/lib/Chromatin/Test/Unit.hs b/lib/Chromatin/Test/Unit.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Test/Unit.hs @@ -0,0 +1,32 @@ +module Chromatin.Test.Unit( + spec, + specWith, + specWithDef, + specConfig, +) where + +import Data.Default.Class (def) +import UnliftIO.STM (newTVarIO) +import Ribosome.Test.Embed (Vars, TestConfig) +import Ribosome.Test.Unit (unitSpec) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Env (Env) +import Chromatin.Test.Config (defaultTestConfig, defaultTestConfigWith) + +specConfig :: TestConfig -> Env -> Chromatin () -> IO () +specConfig conf e s = do + t <- newTVarIO e + unitSpec conf t s + +spec :: Env -> Chromatin () -> IO () +spec = + specConfig defaultTestConfig + +specWith :: Env -> Chromatin () -> Vars -> IO () +specWith e s vars = do + t <- newTVarIO e + unitSpec (defaultTestConfigWith vars) t s + +specWithDef :: Chromatin () -> Vars -> IO () +specWithDef = + specWith def diff --git a/lib/Chromatin/Unload.hs b/lib/Chromatin/Unload.hs new file mode 100644 --- /dev/null +++ b/lib/Chromatin/Unload.hs @@ -0,0 +1,18 @@ +module Chromatin.Unload( + unloadRplugins, +) where + +import Data.Foldable (traverse_) +import qualified Control.Lens as Lens (over) +import qualified Ribosome.Control.Ribo as Ribo (modify) +import Chromatin.Data.Rplugin (Rplugin) +import Chromatin.Data.Chromatin (Chromatin) +import qualified Chromatin.Data.Env as Env (_rplugins) + +unloadRplugin :: Rplugin -> Chromatin () +unloadRplugin rplugin = + Ribo.modify $ Lens.over Env._rplugins $ filter (rplugin ==) + +unloadRplugins :: [Rplugin] -> Chromatin () +unloadRplugins = + traverse_ unloadRplugin diff --git a/test/f/SpecMain.hs b/test/f/SpecMain.hs new file mode 100644 --- /dev/null +++ b/test/f/SpecMain.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module Main where + +import Test.Framework +import Test.Framework.BlackBoxTest () + +main :: IO () +main = + return () + -- htfMain htf_importedTests diff --git a/test/u/BuildSpec.hs b/test/u/BuildSpec.hs new file mode 100644 --- /dev/null +++ b/test/u/BuildSpec.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module BuildSpec( + htf_thisModulesTests +) where + +import Control.Monad.IO.Class (liftIO) +import Data.Default.Class (def) +import Test.Framework +import UnliftIO.Directory (getCurrentDirectory) +import Ribosome.Test.Embed (TestConfig(tcTimeout)) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginSource (RpluginSource(Stack, Pypi), PypiDepspec(..)) +import Chromatin.Test.Unit (specWithDef, specConfig) +import Chromatin.Test.Config (defaultTestConfig) +import Chromatin.Rebuild.Build (installRplugin) +import qualified Chromatin.Rebuild.Build as InstallResult (InstallResult(Success)) +import Config (vars) + +stackSpec :: Chromatin () +stackSpec = do + cwd <- getCurrentDirectory + let name = RpluginName "chromatin" + let source = Stack cwd + result <- installRplugin name source + liftIO $ assertEqual (InstallResult.Success (Rplugin name source)) result + +test_stack :: IO () +test_stack = + vars >>= specWithDef stackSpec + +pypiSpec :: Chromatin () +pypiSpec = do + let name = RpluginName "myo" + let source = Pypi (PypiDepspec "myo~=1.0.0a") + result <- installRplugin name source + liftIO $ assertEqual (InstallResult.Success (Rplugin name source)) result + +testConfig :: TestConfig +testConfig = defaultTestConfig { tcTimeout = 30 } + +test_pypi :: IO () +test_pypi = + specConfig testConfig def pypiSpec diff --git a/test/u/Config.hs b/test/u/Config.hs new file mode 100644 --- /dev/null +++ b/test/u/Config.hs @@ -0,0 +1,9 @@ +module Config( + vars, +) where + +import Ribosome.Test.Embed (Vars(..)) + +vars :: IO Vars +vars = + return $ Vars [] diff --git a/test/u/ConfigSpec.hs b/test/u/ConfigSpec.hs new file mode 100644 --- /dev/null +++ b/test/u/ConfigSpec.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module ConfigSpec( + htf_thisModulesTests +) where + +import Test.Framework +import Chromatin.Data.Rplugins (Rplugins(Rplugins)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginConfig (RpluginConfig(RpluginConfig)) +import Chromatin.Data.RpluginSource (RpluginSource(Hackage), HackageDepspec(HackageDepspec)) +import Chromatin.Config (analyzeConfig, RpluginModification(RpluginNew)) + +rplugins :: Rplugins +rplugins = Rplugins [ + RpluginConfig "hackage:proteome-0.1.0.0" (Just (RpluginName "proteome")), + RpluginConfig "hackage:flagellum" Nothing + ] + +target :: Either String [RpluginModification] +target = Right [ + RpluginNew (RpluginName "proteome") (Hackage (HackageDepspec "proteome-0.1.0.0")), + RpluginNew (RpluginName "flagellum") (Hackage (HackageDepspec "flagellum")) + ] + +test_analyzeConfig :: IO () +test_analyzeConfig = + assertEqual target (analyzeConfig [] rplugins) diff --git a/test/u/DiagSpec.hs b/test/u/DiagSpec.hs new file mode 100644 --- /dev/null +++ b/test/u/DiagSpec.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module DiagSpec( + htf_thisModulesTests +) where + +import Control.Monad.IO.Class (liftIO) +import Data.Default.Class (Default(def)) +import Test.Framework +import Ribosome.Api.Buffer (currentBufferContent) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Test.Unit (specWithDef) +import Chromatin.Diag (crmDiag) +import Config (vars) + +target :: [String] +target = [ + "Diagnostics", + "" + ] + +diagSpec :: Chromatin () +diagSpec = do + crmDiag def + content <- currentBufferContent + liftIO $ assertEqual target content + +test_diag :: IO () +test_diag = + vars >>= specWithDef diagSpec diff --git a/test/u/RebuildSpec.hs b/test/u/RebuildSpec.hs new file mode 100644 --- /dev/null +++ b/test/u/RebuildSpec.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module RebuildSpec( + htf_thisModulesTests +) where + +import Data.Default.Class (Default(def)) +import Control.Monad.IO.Class (liftIO) +import Test.Framework +import Neovim (vim_command') +import Ribosome.Config.Setting (updateSetting) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.Rplugins (Rplugins(Rplugins)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginConfig (RpluginConfig(RpluginConfig)) +import Chromatin.Rebuild (crmRebuild) +import Chromatin.Test.Unit (specWithDef) +import qualified Chromatin.Settings as S (rplugins) +import Config (vars) + +rplugins :: Rplugins +rplugins = Rplugins [ + RpluginConfig "hackage:proteome-0.1.0.0" (Just (RpluginName "proteome")), + RpluginConfig "hackage:flagellum" Nothing + ] + +rebuildSpec :: Chromatin () +rebuildSpec = do + updateSetting S.rplugins rplugins + crmRebuild def + vim_command' "sleep 1" + liftIO $ assertEqual [""] [""] + +test_rebuild :: IO () +test_rebuild = + vars >>= specWithDef rebuildSpec diff --git a/test/u/RunSpec.hs b/test/u/RunSpec.hs new file mode 100644 --- /dev/null +++ b/test/u/RunSpec.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module RunSpec( + htf_thisModulesTests +) where + +import Control.Monad.IO.Class (liftIO) +import Neovim (vim_call_function', toObject, vim_command) +import Test.Framework +import UnliftIO.Directory (getCurrentDirectory) +import Chromatin.Data.Chromatin (Chromatin) +import Chromatin.Data.ActiveRplugin (ActiveRplugin(ActiveRplugin)) +import Chromatin.Data.Rplugin (Rplugin(Rplugin)) +import Chromatin.Data.RpluginName (RpluginName(RpluginName)) +import Chromatin.Data.RpluginSource (RpluginSource(Stack)) +import Chromatin.Test.Unit (specWithDef) +import Chromatin.Run (runRplugin) +import qualified Chromatin.Run as RunRpluginResult (RunRpluginResult(Success)) +import Config (vars) + +runSpec :: Chromatin () +runSpec = do + cwd <- getCurrentDirectory + let rplugin = Rplugin (RpluginName "chromatin") (Stack cwd) + result <- runRplugin rplugin + _ <- vim_command "sleep 500m" + exists <- vim_call_function' "exists" [toObject ":CrmDiag"] + liftIO $ assertEqual (RunRpluginResult.Success (ActiveRplugin 3 rplugin)) result + liftIO $ assertEqual (toObject (2 :: Int)) exists + +test_run :: IO () +test_run = + vars >>= specWithDef runSpec diff --git a/test/u/SpecMain.hs b/test/u/SpecMain.hs new file mode 100644 --- /dev/null +++ b/test/u/SpecMain.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} + +module Main where + +import {-@ HTF_TESTS @-} DiagSpec +import {-@ HTF_TESTS @-} RebuildSpec +import {-@ HTF_TESTS @-} ConfigSpec +import {-@ HTF_TESTS @-} BuildSpec +import {-@ HTF_TESTS @-} RunSpec +import Test.Framework +import Test.Framework.BlackBoxTest () + +main :: IO () +main = htfMain htf_importedTests