Ema.CLI.Action: unGADTify (#160)

* Ema.CLI.Action: unGADTify

This simplifies the type for subsequent changes to be made.

* Include outPath in return

ema-examples/src/Ema/Example/Ex06_Markdown.hs

@@ -11,9 +11,7 @@
 module Ema.Example.Ex06_Markdown where
 
 import Control.Monad.Logger (LogLevel (..), MonadLoggerIO (..), defaultLoc, logInfoNS)
-import Control.Monad.Logger.Extras (runLoggerLoggingT)
 import Data.Default (Default (..))
-import Data.Dependent.Sum (DSum (..))
 import Data.Generics.Sum.Any
 import Data.Map (member)
 import Ema
@@ -126,12 +124,7 @@ runWithFollow ::
 runWithFollow input = do
   cli <- CLI.cliAction
   let cfg = SiteConfig cli followServerOptions
-  result <- snd <$> runSiteWith @Route cfg input
-  case result of
-    CLI.Run _ :=> Identity () ->
-      flip runLoggerLoggingT (CLI.getLogger cli) $
-        CLI.crash "ema" "Live server unexpectedly stopped"
-    CLI.Generate _ :=> Identity _ -> pass
+  void $ snd <$> runSiteWith @Route cfg input
 
 followServerOptions :: EmaServerOptions Route
 followServerOptions = EmaServerOptions wsClientJS followServerHandler

ema-extra/src/Ema/Route/Lib/Extra/StaticRoute.hs

@@ -15,7 +15,6 @@ import Control.Exception (throw)
 import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
-import Data.Some (Some)
 import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
 import Ema
 import Ema.CLI qualified
@@ -31,7 +30,7 @@ newtype StaticRoute (baseDir :: Symbol) = StaticRoute {unStaticRoute :: FilePath
   deriving stock (Generic)
 
 data Model = Model
-  { modelCliAction :: Some Ema.CLI.Action
+  { modelCliAction :: Ema.CLI.Action
   , modelFiles :: Map FilePath UTCTime
   }
   deriving stock (Eq, Show, Generic)
@@ -97,7 +96,8 @@ staticRouteUrl rp model fp =
         -- In statically generated site, do it only for CSS and JS files.
         guard $
           Ema.CLI.isLiveServer (modelCliAction model)
-            || takeExtension fp `List.elem` [".css", ".js"]
+            || takeExtension fp
+              `List.elem` [".css", ".js"]
         pure $ "?" <> tag
 
 lookupMust :: FilePath -> Model -> UTCTime

ema/CHANGELOG.md

@@ -4,6 +4,7 @@
 
 - Relax `base` constraint forever
 - Live server shim/websocket customization ([\#152](https://github.com/srid/ema/pull/152)) @lucasvreis
+- `Ema.CLI`: The `Action` type is no longer a GADT.
 
 ## 0.10.2.0 (2023-08-09)
 

ema/ema.cabal

@@ -80,10 +80,7 @@ library
     , aeson
     , async
     , base                   >=4.13.0.0 && <4.99
-    , constraints-extras
     , data-default
-    , dependent-sum
-    , dependent-sum-template
     , directory
     , file-embed
     , filepath

ema/src/Ema/App.hs

@@ -12,9 +12,7 @@ import Control.Concurrent.Async (race_)
 import Control.Monad.Logger (LoggingT (runLoggingT), MonadLoggerIO (askLoggerIO), logInfoNS, logWarnNS)
 import Control.Monad.Logger.Extras (runLoggerLoggingT)
 import Data.Default (Default, def)
-import Data.Dependent.Sum (DSum ((:=>)))
 import Data.LVar qualified as LVar
-import Data.Some (Some (Some))
 import Ema.CLI (getLogger)
 import Ema.CLI qualified as CLI
 import Ema.Dynamic (Dynamic (Dynamic))
@@ -48,17 +46,11 @@ runSite ::
   (Show r, Eq r, EmaStaticSite r) =>
   -- | The input required to create the `Dynamic` of the `RouteModel`
   SiteArg r ->
-  IO [FilePath]
+  IO (FilePath, [FilePath])
 runSite input = do
   cli <- CLI.cliAction
   let cfg = SiteConfig cli def
-  result <- snd <$> runSiteWith @r cfg input
-  case result of
-    CLI.Run _ :=> Identity () ->
-      flip runLoggerLoggingT (getLogger cli) $
-        CLI.crash "ema" "Live server unexpectedly stopped"
-    CLI.Generate _ :=> Identity fs ->
-      pure fs
+  snd <$> runSiteWith @r cfg input
 
 -- | Like @runSite@ but discards the result
 runSite_ :: forall r. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO ()
@@ -79,7 +71,8 @@ runSiteWith ::
   IO
     ( -- The initial model value.
       RouteModel r
-    , DSum CLI.Action Identity
+    , -- Out path, and the list of statically generated files
+      (FilePath, [FilePath])
     )
 runSiteWith cfg siteArg = do
   let opts = siteConfigServerOpts cfg
@@ -89,10 +82,10 @@ runSiteWith cfg siteArg = do
     logInfoNS "ema" $ "Launching Ema under: " <> toText cwd
     Dynamic (model0 :: RouteModel r, cont) <- siteInput @r (CLI.action cli) siteArg
     case CLI.action cli of
-      Some act@(CLI.Generate dest) -> do
+      CLI.Generate dest -> do
         fs <- generateSiteFromModel @r dest model0
-        pure (model0, act :=> Identity fs)
-      Some act@(CLI.Run (host, mport)) -> do
+        pure (model0, (dest, fs))
+      CLI.Run (host, mport) -> do
         model <- LVar.empty
         LVar.set model model0
         logger <- askLoggerIO
@@ -108,4 +101,4 @@ runSiteWith cfg siteArg = do
             ( flip runLoggingT logger $ do
                 Server.runServerWithWebSocketHotReload @r opts host mport model
             )
-        pure (model0, act :=> Identity ())
+        CLI.crash "ema" "Live server unexpectedly stopped"

ema/src/Ema/CLI.hs

@@ -10,14 +10,7 @@ import Control.Monad.Logger.Extras (
   colorize,
   logToStdout,
  )
-import Data.Constraint.Extras.TH (deriveArgDict)
 import Data.Default (Default (def))
-import Data.GADT.Compare.TH (
-  DeriveGCompare (deriveGCompare),
-  DeriveGEQ (deriveGEq),
- )
-import Data.GADT.Show.TH (DeriveGShow (deriveGShow))
-import Data.Some (Some (..))
 import Network.Wai.Handler.Warp (Port)
 import Options.Applicative hiding (action)
 
@@ -29,25 +22,21 @@ instance Default Host where
   def = "127.0.0.1"
 
 -- | CLI subcommand
-data Action result where
-  -- | Generate static files at the given output directory, returning the list
+data Action
+  = -- | Generate static files at the given output directory, returning the list
     -- of generated files.
-  Generate :: FilePath -> Action [FilePath]
-  -- | Run the live server
-  Run :: (Host, Maybe Port) -> Action ()
+    Generate FilePath
+  | -- | Run the live server
+    Run (Host, Maybe Port)
+  deriving stock (Eq, Show, Generic)
 
-$(deriveGEq ''Action)
-$(deriveGShow ''Action)
-$(deriveGCompare ''Action)
-$(deriveArgDict ''Action)
-
-isLiveServer :: Some Action -> Bool
-isLiveServer (Some (Run _)) = True
+isLiveServer :: Action -> Bool
+isLiveServer (Run _) = True
 isLiveServer _ = False
 
 -- | Ema's command-line interface options
 data Cli = Cli
-  { action :: Some Action
+  { action :: Action
   -- ^ The Ema action to run
   , verbose :: Bool
   -- ^ Logging verbosity
@@ -56,7 +45,7 @@ data Cli = Cli
 
 instance Default Cli where
   -- By default, run the live server on random port.
-  def = Cli (Some (Run def)) False
+  def = Cli (Run def) False
 
 cliParser :: Parser Cli
 cliParser = do
@@ -65,16 +54,16 @@ cliParser = do
       ( command "gen" (info generate (progDesc "Generate static site"))
           <> command "run" (info run (progDesc "Run the live server"))
       )
-      <|> pure (Some $ Run def)
+      <|> pure (Run def)
   verbose <- switch (long "verbose" <> short 'v' <> help "Enable verbose logging")
   pure Cli {..}
   where
-    run :: Parser (Some Action)
+    run :: Parser Action
     run =
-      fmap (Some . Run) $ (,) <$> hostParser <*> optional portParser
-    generate :: Parser (Some Action)
+      fmap Run $ (,) <$> hostParser <*> optional portParser
+    generate :: Parser Action
     generate =
-      Some . Generate <$> argument str (metavar "DEST")
+      Generate <$> argument str (metavar "DEST")
 
 hostParser :: Parser Host
 hostParser =

ema/src/Ema/Site.hs

@@ -6,7 +6,6 @@ module Ema.Site (
 ) where
 
 import Control.Monad.Logger (MonadLoggerIO)
-import Data.Some (Some)
 import Ema.Asset (Asset)
 import Ema.CLI qualified as CLI
 import Ema.Dynamic (Dynamic)
@@ -54,7 +53,7 @@ class (IsRoute r) => EmaSite r where
   siteInput ::
     forall m.
     (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
-    Some CLI.Action ->
+    CLI.Action ->
     -- | The value passed by the programmer to `Ema.App.runSite`
     SiteArg r ->
     -- | Time-varying value of the model. If your model is not time-varying, use