factor out

srid · Mar 10, 2024 · d6789bc · d6789bc
1 parent ada58e9
commit d6789bc
Show file tree

Hide file tree

Showing 4 changed files with 24 additions and 14 deletions.
diff --git 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,40 +18,49 @@ 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'
           , metavar "LAYERS"
           , 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
@@ -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
@@ -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
@@ -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