on master help sign in
Delete remnants of StaticPointer usage
adac5e3Elliot Cameron
lib/command/obelisk-command.cabal+1−2
@@ -60,8 +60,7 @@ library
60 Obelisk.Command.Utils
60 Obelisk.Command.Utils
61 Obelisk.Command.VmBuilder
61 Obelisk.Command.VmBuilder
62 Obelisk.Command.Preprocessor
62 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
65
64
66executable ob
65executable ob
67 main-is: src-bin/ob.hs
66 main-is: src-bin/ob.hs
lib/command/src/Obelisk/Command.hs+16−34
@@ -3,8 +3,6 @@
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE StaticPointers #-}
7−{-# LANGUAGE TypeApplications #-}
8module Obelisk.Command where
6module Obelisk.Command where
9
7
10import Control.Monad
8import Control.Monad
@@ -99,34 +97,28 @@ data ObCommand
99 deriving Show
97 deriving Show
100
98
101data ObInternal
99data ObInternal
102− = ObInternal_RunStaticIO StaticKey
103 -- the preprocessor argument syntax is also handled outside
100 -- the preprocessor argument syntax is also handled outside
104 -- optparse-applicative, but it shouldn't ever conflict with another syntax
101 -- optparse-applicative, but it shouldn't ever conflict with another syntax
105− | ObInternal_ApplyPackages String String String [String]
102+ = ObInternal_ApplyPackages String String String [String]
106 deriving Show
103 deriving Show
107
104
108obCommand :: ArgsConfig -> Parser ObCommand
105obCommand :: ArgsConfig -> Parser ObCommand
109obCommand cfg = hsubparser
106obCommand cfg = hsubparser
110− (mconcat
107+ (mconcat
111− [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
108+ [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
112− , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
109+ , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
113− , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
110+ , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
114− , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
111+ , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
115− , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
112+ , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
116− , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
113+ , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
117− , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"
114+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"
118− , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $
115+ , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $
119− progDesc "List paths to haddock documentation for specified packages"
116+ progDesc "List paths to haddock documentation for specified packages"
120− <> footerDoc (Just $
117+ <> footerDoc (Just $
121− text "Hint: To open the documentation you can pipe the output of this command like"
118+ text "Hint: To open the documentation you can pipe the output of this command like"
122− <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")
119+ <$$> text "ob doc reflex reflex-dom-core | xargs -n1 xdg-open")
123− , command "hoogle" $ info (ObCommand_Hoogle <$> shellFlags <*> portOpt 8080) $ progDesc "Run a hoogle server locally for your project's dependency tree"
120+ , command "hoogle" $ info (ObCommand_Hoogle <$> shellFlags <*> portOpt 8080) $ progDesc "Run a hoogle server locally for your project's dependency tree"
124− ])
125− <|> subparser
126− (mconcat
127− [ internal
128− , command "internal" (info (ObCommand_Internal <$> internalCommand) mempty)
129− ])
121+ ])
130
122
131packageNames :: Parser [String]
123packageNames :: Parser [String]
132packageNames = some (strArgument (metavar "PACKAGE-NAME..."))
124packageNames = some (strArgument (metavar "PACKAGE-NAME..."))
@@ -191,11 +183,6 @@ data DeployInitOpts = DeployInitOpts
191 }
183 }
192 deriving Show
184 deriving Show
193
185
194−internalCommand :: Parser ObInternal
195−internalCommand = subparser $ mconcat
196− [ command "run-static-io" $ info (ObInternal_RunStaticIO <$> argument (eitherReader decodeStaticKey) (action "static-key")) mempty
197− ]
198−
199--TODO: Result should provide normalised path and also original user input for error reporting.
186--TODO: Result should provide normalised path and also original user input for error reporting.
200thunkDirectoryParser :: Parser FilePath
187thunkDirectoryParser :: Parser FilePath
201thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat
188thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat
@@ -392,11 +379,6 @@ ob = \case
392 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do
379 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do
393 nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"
380 nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"
394 ObCommand_Internal icmd -> case icmd of
381 ObCommand_Internal icmd -> case icmd of
395− ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case -- TODO: DELETE
396− Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)
397− Just p -> do
398− c <- getObelisk
399− liftIO $ runObelisk c $ deRefStaticPtr p
400 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do
382 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do
401 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths
383 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths
402
384