f1c4331 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge pull request #637 from obsidiansystems/eac@cleanup-ob-internal

Dead code GC

commitf1c4331dd9a20de0e8481625c6fbba3c4ce15c25 authorElliot Cameron <3noch@users.noreply.github.com> dateThu 30 Jan 2020, 23:45 (7 years ago) parentf59c657 adac5e3

4 files changed+17−93

compare with master

unifiedsplit

lib/cliapp/obelisk-cliapp.cabal−1 lib/cliapp/src/Obelisk/CliApp/Demo.hs−52 lib/command/obelisk-command.cabal+1−2 lib/command/src/Obelisk/Command.hs+16−38

lib/cliapp/obelisk-cliapp.cabal−1

@@ -25,7 +25,6 @@ library

2525 , transformers

2626 exposed-modules:

2727 Obelisk.CliApp

28− Obelisk.CliApp.Demo

2928 other-modules:

3029 Obelisk.CliApp.Logging

3130 Obelisk.CliApp.Process

lib/cliapp/src/Obelisk/CliApp/Demo.hsdeleted−52

@@ -1,52 +0,0 @@

1−{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−module Obelisk.CliApp.Demo where

5−

6−import Control.Concurrent (threadDelay)

7−import Control.Monad.Fail

8−import Control.Monad.IO.Class

9−import Data.Semigroup ((<>))

10−import qualified Data.Text as T

11−

12−import Control.Monad.Catch (MonadMask)

13−

14−import Obelisk.CliApp

15−

16−cliDemo

17− :: ( MonadIO m, MonadMask m, MonadFail m

18− , CliLog m, HasCliConfig e m, CliThrow e m, AsProcessFailure e, AsUnstructuredError e)

19− => m ()

20−cliDemo = withSpinner "CLI Demo" $ do

21− putLog Notice "This demo will showcase the CLI library functionality"

22− _ <- withSpinner' "Searching long for something" (Just $ \c -> "Discovered " <> T.pack (show c) <> " objects") $ do

23− delay

24− withSpinner "Nested task" $ do

25− delay

26− putLog Notice "In nested task"

27− -- This is a 'no trail' spinner that won't leave a trail (even its sub spinners)

28− withSpinnerNoTrail "In between, doing something temporary" $ do

29− withSpinner "Runnning something deep inside" $ do

30− delay

31− putLog Notice "You can still log from inside no-trail spinners"

32− delay

33− delay

34− putLog Error "Top nested task finished"

35− delay

36− putLog Error "Some user error while spinning"

37− delay

38− putLog Notice "This is some info mesage"

39− putLog Warning "And now a warning as well"

40− delay

41− return (42 :: Integer)

42− putLog Notice "Now we start a 2nd spinner, run a couple of process, the last of which fails:"

43− withSpinner "Looking around" $ do

44− delay

45− output <- readProcessAndLogStderr Notice $ proc "ls" ["-l", "/"]

46− putLog Notice $ "Output was: " <> output

47− delay

48− callProcessAndLogOutput (Notice, Error) $ proc "ls" ["-l", "/does-not-exist"]

49− delay

50− failWith "Something dangerous happened"

51− where

52− delay = liftIO $ threadDelay 1000000

lib/command/obelisk-command.cabal+1−2

@@ -60,8 +60,7 @@ library

6060 Obelisk.Command.Utils

6161 Obelisk.Command.VmBuilder

6262 Obelisk.Command.Preprocessor

63− -- -fobject-code is so that the StaticPointers extension can work in ghci

64− ghc-options: -Wall -fobject-code

63+ ghc-options: -Wall

6564

6665executable ob

6766 main-is: src-bin/ob.hs

lib/command/src/Obelisk/Command.hs+16−38

@@ -3,8 +3,6 @@

33{-# LANGUAGE MultiParamTypeClasses #-}

44{-# LANGUAGE OverloadedStrings #-}

55{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE StaticPointers #-}

7−{-# LANGUAGE TypeApplications #-}

86module Obelisk.Command where

108import Control.Monad

@@ -30,7 +28,6 @@ import System.Posix.Process (executeFile)

3028

3129import Obelisk.App

3230import Obelisk.CliApp

33−import Obelisk.CliApp.Demo (cliDemo)

3431import Obelisk.Command.Deploy

3532import Obelisk.Command.Project

3633import Obelisk.Command.Run

@@ -100,35 +97,28 @@ data ObCommand

10097 deriving Show

10198

10299data ObInternal

103− = ObInternal_RunStaticIO StaticKey

104− | ObInternal_CLIDemo

105100 -- the preprocessor argument syntax is also handled outside

106101 -- optparse-applicative, but it shouldn't ever conflict with another syntax

107− | ObInternal_ApplyPackages String String String [String]

102+ = ObInternal_ApplyPackages String String String [String]

108103 deriving Show

109104

110105obCommand :: ArgsConfig -> Parser ObCommand

111106obCommand cfg = hsubparser

112− (mconcat

113− [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"

114− , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"

115− , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"

116− , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"

117− , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"

118− , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"

119− , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"

120− , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

121− progDesc "List paths to haddock documentation for specified packages"

122− <> footerDoc (Just $

123− text "Hint: To open the documentation you can pipe the output of this command like"

124− <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")

125− , command "hoogle" $ info (ObCommand_Hoogle <$> shellFlags <*> portOpt 8080) $ progDesc "Run a hoogle server locally for your project's dependency tree"

126− ])

127− <|> subparser

128− (mconcat

129− [ internal

130− , command "internal" (info (ObCommand_Internal <$> internalCommand) mempty)

131− ])

107+ (mconcat

108+ [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"

109+ , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"

110+ , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"

111+ , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"

112+ , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"

113+ , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"

114+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"

115+ , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

116+ progDesc "List paths to haddock documentation for specified packages"

117+ <> footerDoc (Just $

118+ text "Hint: To open the documentation you can pipe the output of this command like"

119+ <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")

120+ , command "hoogle" $ info (ObCommand_Hoogle <$> shellFlags <*> portOpt 8080) $ progDesc "Run a hoogle server locally for your project's dependency tree"

121+ ])

132122

133123packageNames :: Parser [String]

134124packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

@@ -193,12 +183,6 @@ data DeployInitOpts = DeployInitOpts

193183 }

194184 deriving Show

195185

196−internalCommand :: Parser ObInternal

197−internalCommand = subparser $ mconcat

198− [ command "run-static-io" $ info (ObInternal_RunStaticIO <$> argument (eitherReader decodeStaticKey) (action "static-key")) mempty

199− , command "clidemo" $ info (pure ObInternal_CLIDemo) mempty

200− ]

201−

202186--TODO: Result should provide normalised path and also original user input for error reporting.

203187thunkDirectoryParser :: Parser FilePath

204188thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat

@@ -395,12 +379,6 @@ ob = \case

395379 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

396380 nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"

397381 ObCommand_Internal icmd -> case icmd of

398− ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case -- TODO: DELETE

399− Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

400− Just p -> do

401− c <- getObelisk

402− liftIO $ runObelisk c $ deRefStaticPtr p

403− ObInternal_CLIDemo -> cliDemo -- TODO: DELETE

404382 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

405383 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

406384