From d6789bc7fe06ca7d27e93a25e129c6a65f91e2d0 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Sun, 10 Mar 2024 10:46:23 -0400 Subject: [PATCH] factor out --- emanote/src/Emanote/CLI.hs | 24 +++++++++++++++++------- emanote/src/Emanote/Source/Dynamic.hs | 2 +- emanote/src/Emanote/Source/Loc.hs | 6 +++--- emanote/src/Emanote/Source/Patch.hs | 6 +++--- 4 files changed, 24 insertions(+), 14 deletions(-) diff --git a/emanote/src/Emanote/CLI.hs b/emanote/src/Emanote/CLI.hs index b409c0034..e5fc03c4d 100644 --- a/emanote/src/Emanote/CLI.hs +++ b/emanote/src/Emanote/CLI.hs @@ -3,6 +3,7 @@ module Emanote.CLI ( Cli (..), + Layer (..), Cmd (..), parseCli, cliParser, @@ -17,26 +18,31 @@ import Relude import UnliftIO.Directory (getCurrentDirectory) data Cli = Cli - { layers :: NonEmpty (FilePath, Maybe FilePath) + { layers :: NonEmpty Layer , allowBrokenLinks :: Bool , cmd :: Cmd } +data Layer = Layer + { path :: FilePath + , mountPoint :: Maybe FilePath + } + data Cmd = Cmd_Ema Ema.CLI.Cli | Cmd_Export cliParser :: FilePath -> Parser Cli cliParser cwd = do - layers <- pathList (one (cwd, Nothing)) + layers <- layerList $ one $ Layer cwd Nothing allowBrokenLinks <- switch (long "allow-broken-links" <> help "Report but do not fail on broken links") cmd <- fmap Cmd_Ema Ema.CLI.cliParser <|> subparser (command "export" (info (pure Cmd_Export) (progDesc "Export metadata JSON"))) pure Cli {..} where - pathList defaultPath = do - option pathListReader + layerList defaultPath = do + option layerListReader $ mconcat [ long "layers" , short 'L' @@ -44,13 +50,17 @@ cliParser cwd = do , value defaultPath , help "List of (semicolon delimited) notebook folders to 'union mount', with the left-side folders being overlaid on top of the right-side ones. The default layer is implicitly included at the end of this list." ] - pathListReader :: ReadM (NonEmpty (FilePath, Maybe FilePath)) - pathListReader = do + layerListReader :: ReadM (NonEmpty Layer) + layerListReader = do let partition s = T.breakOn "@" s & second (\x -> if T.null s then Nothing else Just $ T.drop 1 x) maybeReader $ \paths -> - nonEmpty $ fmap (bimap toString (fmap toString) . partition) $ T.split (== ';') . toText $ paths + nonEmpty + $ fmap (uncurry Layer . bimap toString (fmap toString) . partition) + $ T.split (== ';') + . toText + $ paths parseCli' :: FilePath -> ParserInfo Cli parseCli' cwd = diff --git a/emanote/src/Emanote/Source/Dynamic.hs b/emanote/src/Emanote/Source/Dynamic.hs index 187bd9ec6..53c2ffac4 100644 --- a/emanote/src/Emanote/Source/Dynamic.hs +++ b/emanote/src/Emanote/Source/Dynamic.hs @@ -55,7 +55,7 @@ emanoteSiteInput cliAct EmanoteConfig {..} = do defaultLayer <- Loc.defaultLayer <$> liftIO Paths_emanote.getDataDir instanceId <- liftIO UUID.nextRandom storkIndex <- Stork.newIndex - let layers = Loc.userLayers (CLI.layers _emanoteConfigCli) <> one defaultLayer + let layers = Loc.userLayers ((CLI.path &&& CLI.mountPoint) <$> CLI.layers _emanoteConfigCli) <> one defaultLayer initialModel = Model.emptyModel layers cliAct _emanoteConfigPandocRenderers _emanoteCompileTailwind instanceId storkIndex scriptingEngine <- getEngine Dynamic diff --git a/emanote/src/Emanote/Source/Loc.hs b/emanote/src/Emanote/Source/Loc.hs index 20243b146..2eb0677b8 100644 --- a/emanote/src/Emanote/Source/Loc.hs +++ b/emanote/src/Emanote/Source/Loc.hs @@ -53,9 +53,9 @@ defaultLayer = LocDefault userLayers :: NonEmpty (FilePath, Maybe FilePath) -> Set Loc userLayers paths = - fromList $ - zip [1 ..] (toList paths) - <&> (\(a, (b, c)) -> LocUser a b c) + fromList + $ zip [1 ..] (toList paths) + <&> (\(a, (b, c)) -> LocUser a b c) -- | Return the effective path of a file. locResolve :: (Loc, FilePath) -> FilePath diff --git a/emanote/src/Emanote/Source/Patch.hs b/emanote/src/Emanote/Source/Patch.hs index bbb57bb3e..8dcc70e5f 100644 --- a/emanote/src/Emanote/Source/Patch.hs +++ b/emanote/src/Emanote/Source/Patch.hs @@ -107,9 +107,9 @@ patchModel' layers noteF storkIndexTVar scriptingEngine fpType fp action = do let fpAbs = locResolve overlay traverseToSnd (readRefreshedFile refreshAction) fpAbs sData <- - liftIO $ - either (throwIO . BadInput) pure $ - SD.parseSDataCascading r yamlContents + liftIO + $ either (throwIO . BadInput) pure + $ SD.parseSDataCascading r yamlContents pure $ M.modelInsertData sData UM.Delete -> do log $ "Removing data: " <> toText fp