Setup basic configuration.

4 files changed, 135 insertions, 51 deletions

diff --git a/hs/Config.hs b/hs/Config.hs
new file mode 100644
index 0000000..691f67f
--- /dev/null
+++ b/hs/Config.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE TemplateHaskell
+           , OverloadedStrings
+  #-}
+
+module Config where
+
+import Control.Lens
+
+import Options.Applicative
+
+import Data.Ini.Config
+
+data Args = Args
+    { indir :: String
+    , outdir :: String
+    }
+
+argp :: Parser Args
+argp = Args
+    <$> strOption (long "indir" <> short 'i' <> help "Input Directory" <> metavar "DIR")
+    <*> strOption (long "outdir" <> short 'o' <> help "Output Directory" <> metavar "DIR")
+
+opts = info (argp <**> helper) 
+            (fullDesc 
+            <> progDesc "Build Vimwiki" 
+            <> header "build - build vimwiki")
+
+{-
+data Wiki = Wiki
+    { name :: String
+    , url  :: String } deriving (Eq, Show)
+-}
+
+data Configuration = Configuration
+    { _output :: OutputConfig
+    , _data'  :: DataConfig
+    -- , _wikis :: [Wiki]
+    } deriving (Eq, Show)
+
+data DataConfig = DataConfig
+    -- Source of vimwiki files
+    { _inputDir  :: FilePath
+    -- where generated pages should be placed
+    , _outputDir :: FilePath
+    } deriving (Eq, Show)
+
+data OutputConfig = OutputConfig
+    { _mu4eURL     :: Maybe String
+    , _xapianOmega :: Maybe String
+    -- Are we in a subdirectory from the web root?
+    , _webPath     :: String
+    } deriving (Eq, Show)
+
+makeLenses ''Configuration
+makeLenses ''DataConfig
+makeLenses ''OutputConfig
+
+confParser :: IniParser Configuration
+confParser = do
+    out <- section "Output" $ do
+        mu4eURL     <- fieldMbOf "mu4eURL" string
+        xapianOmega <- fieldMbOf "xapianOmega" string
+        webPath     <- fieldDefOf "webpath" string ""
+        return OutputConfig { _mu4eURL = mu4eURL
+                            , _xapianOmega = xapianOmega
+                            , _webPath = webPath }
+    data' <- sectionDef "Data" (_data' defaultConf) $ do
+        inputDir  <- fieldOf "inputDir" string
+        outputDir <- fieldOf "outputDir" string
+        return DataConfig { _inputDir = inputDir, _outputDir = outputDir }
+    -- wikis <- section "wikis"
+    return $ Configuration out data'
+
+runParser = flip parseIniFile $ confParser 
+
+parseCmdline = execParser opts
+
+defaultConf = Configuration
+    { _output = OutputConfig
+                { _mu4eURL     = Nothing
+                , _xapianOmega = Nothing
+                , _webPath      = ""
+                }
+    , _data' = DataConfig
+                { _inputDir = "/home/user/wiki"
+                , _outputDir = "/tmp/wiki-output"
+                }
+    }
diff --git a/hs/Html.hs b/hs/Html.hs
index 0e5b0fe..8a24e48 100644
--- a/hs/Html.hs
+++ b/hs/Html.hs
@@ -7,7 +7,9 @@ module Html
 ( main
 ) where
 
-import System.Environment (getArgs, lookupEnv)
+import Control.Lens.Operators hiding ((<.>))
+
+import System.Environment (lookupEnv)
 import System.FilePath
     ( joinPath
     , takeDirectory
@@ -18,7 +20,7 @@ import System.FilePath
     , dropExtension
     , takeBaseName
     )
-import System.Directory (copyFile)
+import System.Directory (copyFile, createDirectoryIfMissing)
 
 import Text.Pandoc
     ( PandocMonad
@@ -51,13 +53,13 @@ import Text.Pandoc.Writers.Shared
     , lookupMetaString
     )
 
-import System.IO (readFile')
 import Data.Text (Text, unpack, pack)
 import Data.Text.IO qualified as T
 import Data.Text.Lazy (toStrict)
 --import Network.URI --(parseURI, uriPath, uriScheme, uriFragment, uriQuery, uriAuthority, URI, URIAuth)
 import Network.URI hiding (query)
-import Data.Maybe (listToMaybe, fromMaybe)
+import Network.URI.Lens
+import Data.Maybe (listToMaybe, fromMaybe, fromJust)
 import Data.List (partition)
 
 import Control.Monad.IO.Class (liftIO)
@@ -71,9 +73,9 @@ import Text.Pandoc.Walk
     ( Walkable (..)
     , walk )
 
-import Text.Blaze.Html5 hiding (main, html)
+import Text.Blaze.Html5 hiding (main, html, summary, header, string, section, output)
 import Text.Blaze.Html5 qualified as H
-import Text.Blaze.Html5.Attributes
+import Text.Blaze.Html5.Attributes hiding (summary)
 import Text.Blaze.Html5.Attributes qualified as A
 
 import Text.Pandoc.Definition
@@ -87,6 +89,7 @@ import Text.Pandoc.Definition
 import Files
 import Links
 import Util
+import Config
 
 -- import Text.DocTemplates (Context(..), ToContext(toVal))
 import Data.Map qualified as M
@@ -94,7 +97,6 @@ import Data.Set (Set)
 import Data.Set qualified as S
 import Data.String (IsString)
 
-
 isWikiFile = isFiletype "wiki"
 
 -- TODO
@@ -114,22 +116,10 @@ vimwikiToHTML txt = do
     return $ toStrict . renderHtml $ html
 -}
 
-data Configuration = Configuration
-    { inputDir :: FilePath
-    , outputDir :: FilePath
-    -- Are we in a subdirectory from the web root?
-    -- /tmp/wiki
-    , webPath :: Text
-    -- http://localhost:8090/
-    , mu4eURL :: Text
-    -- http://wiki.gandalf.adrift.space/search
-    , xapianOmega :: Text
-    } deriving (Read, Show)
-
 type UrlRewriter = [Inline] -> URI -> ([Inline], Text)
 
-mailRewriter :: Configuration -> UrlRewriter
-mailRewriter conf body uri = (body, (mu4eURL conf) <> "?id=" <> (pack $ uriPath uri))
+mailRewriter :: String -> UrlRewriter
+mailRewriter mu4eURL body uri = (body, pack $ mu4eURL <> "?id=" <> uriPath uri)
 
 -- Comparison of online man pages:
 -- https://gist.github.com/rixx/6cb5fa38f694009ad0bd50c275bb61f2
@@ -154,7 +144,7 @@ manRewriter _ uri
           language' = pack . tail <$> nullToMaybe (uriQuery uri)
 
 urlRewrites :: Configuration -> M.Map String UrlRewriter
-urlRewrites conf = M.fromList [ ("mail", mailRewriter conf)
+urlRewrites conf = M.fromList [ ("mail", mailRewriter $ (fromJust $ conf ^. output . mu4eURL))
                               , ("man", manRewriter)
                               ]
 
@@ -171,8 +161,8 @@ fixExtension url
 resolveInterwiki :: String -> URI -> String
 resolveInterwiki wikiname uri =
     case wikiname of
-        "public"  -> show $ uri { uriScheme = "http:", uriAuthority = Just $ URIAuth "" "//wiki.gandalf.adrift.space" "", uriPath = "/" <> uriPath uri <> ".html" }
-        "private" -> show $ uri { uriScheme = "http:", uriAuthority = Just $ URIAuth "" "//wiki.gandalf.adrift.space" "", uriPath = "/private/" <> uriPath uri <> ".html" }
+        "public"  -> show $ (fromJust $ parseURI "http://wiki.gandalf.adrift.space/")         & uriPathLens %~ (<> uriPath uri <> ".html")
+        "private" -> show $ (fromJust $ parseURI "http://wiki.gandalf.adrift.space/private/") & uriPathLens %~ (<> uriPath uri <> ".html")
         _         -> error $ "Unknown Wiki name: '" <> wikiname <> "'"
 
 
@@ -259,7 +249,7 @@ handleSourceText conf text = do
 -- Link (_,_,_) _ (_, "wikilink")
 
 breadcrumbLinks :: Configuration -> [FilePath] -> [String]
-breadcrumbLinks conf parts = f <$> (accumulate $ (unpack $ webPath conf) : parts)
+breadcrumbLinks conf parts = f <$> (accumulate $ (conf ^. output . webPath) : parts)
     where f parts = joinBy "/" parts -<.> "html"
 
 buildBreadcrumbs :: [String] -> [Html]
@@ -275,21 +265,21 @@ htmlWrap conf title parts backlinks toc main = docTypeHtml $ do
     H.meta ! charset "utf-8"
     H.meta ! name "generator" ! content "pandoc"
     H.meta ! name "viewport" ! content "width=device-width, initial-scale=1.0, user-scalable=yes"
-    H.link ! rel "stylesheet" ! (href . textValue $ webPath conf <> "/style.css")
-    H.script ! (A.src . textValue $ (webPath conf <> "/script.js")) $ mempty
+    H.link ! rel "stylesheet" ! (href . textValue $ (pack $ conf ^. output . webPath) <> "/style.css")
+    H.script ! (A.src . textValue $ ((pack $ conf ^. output . webPath) <> "/script.js")) $ mempty
     H.title $ H.string $ title <> " — Vimwiki"
   H.body $ do
     H.header $ do
         H.nav ! A.id "breadcrumb" $ do
             let bc = (buildBreadcrumbs . breadcrumbLinks conf $ init parts)
-            let all = mconcat [ [ H.a ! (href . textValue $ webPath conf <> "/index.html")
+            let all = mconcat [ [ H.a ! (href . textValue $ (pack $ conf ^. output . webPath) <> "/index.html")
                                       $ "⌂" ]
                               , tail bc
                               , [ H.span $ H.string . takeBaseName . last $ parts ] ]
             mconcat $ intersperse (H.string "»") all
         H.nav ! A.id "search" $ do
             H.form ! A.method "GET"
-                   ! A.action (textValue . xapianOmega $ conf)
+                   ! A.action (textValue . pack . fromJust $ conf ^. output . xapianOmega)
                    $ do
                      H.input ! A.type_ "search" ! A.name "P" ! A.placeholder "Sök..."
                      H.input ! A.type_ "submit" ! A.value "Sök"
@@ -351,34 +341,36 @@ handlePart conf outdir backlinks wiki_root parts = do
     let htmlString = toStrict . renderHtml . htmlWrap conf (unpack title) parts bl toc $ html
     liftIO $ T.writeFile outTarget htmlString
 
+-- TODO copy remaining files verbatim
+main = do
+    args <- parseCmdline
+    let indir' = indir args
+    let outdir' = outdir args
+    (wiki_files, other_files) <- partition (uncurry isWikiFile) <$> fileTree [ indir' ]
 
+    wp <- fromMaybe "" <$> lookupEnv "WEB_PATH"
 
-main = do
-    args <- getArgs
-    (indir, outdir) <- case args of
-        [indir, outdir] -> return (indir, outdir)
-        _ -> error "Usage: vimwiki <indir> <outdir>"
-    (wiki_files, other_files) <- partition (uncurry isWikiFile) <$> fileTree [ indir ]
-    -- TODO copy remaining files verbatim
-    -- st <- getFileStatus $ indir </> "Vimwiki.wiki"
-    -- wiki_files <- return $ [(st, snoc [ indir ] "Vimwiki.wiki")]
-    let relative_paths = tail . snd <$> wiki_files
+    confText <- T.readFile "config.ini"
+    conf' <- case runParser confText of
+        Left err -> error err
+        Right conf -> return conf
 
-    webPath <- pack . fromMaybe "" <$> lookupEnv "WEB_PATH"
+    -- conf' <- (read :: String -> Configuration) <$> readFile' "/home/hugo/code/vimwiki-scripts/hs/config.hs"
+    -- TODO Merge defaultConfig
+    let conf = (conf' & data' . inputDir .~ indir'
+                      & data' . outputDir .~ outdir'
+                      & output . webPath .~ wp
+                       )
 
-    conf' <- (read :: String -> Configuration) <$> readFile' "config.hs"
-    let conf = conf' { inputDir = indir
-                     , outputDir = outdir
-                     -- , webPath = "/tmp/wiki"
-                     , webPath = webPath
-                     }
+    createDirectoryIfMissing True $ conf ^. data' . outputDir
 
-    copyFile "style2.css" (outputDir conf <> "/style.css")
-    copyFile "script.js" (outputDir conf <> "/script.js")
+    copyFile "style2.css" (conf ^. (data' . outputDir) <> "/style.css")
+    copyFile "script.js"  (conf ^. (data' . outputDir) <> "/script.js")
 
     -- What each page links to
     -- forwardLinks :: [(FilePath, [String])]
-    forwardLinks <- runIOorExplode $ mapM (findLinks indir) relative_paths
+    let relative_paths = tail . snd <$> wiki_files
+    forwardLinks <- runIOorExplode $ mapM (findLinks indir') relative_paths
     -- TODO backlinks should look at basename of filename, for both
     -- link and target.
     -- http://wiki.gandalf.adrift.space/Lysator/Styrelse/wi_1233359070.html
@@ -392,5 +384,5 @@ main = do
             Nothing -> return ()
             Just l -> setTranslations l
 
-        mapM_ (handlePart conf outdir backlinks indir) relative_paths
+        mapM_ (handlePart conf outdir' backlinks indir') relative_paths
     -- mapM_ (putStrLn . show) wiki_files
diff --git a/hs/Util.hs b/hs/Util.hs
index 54a334e..77e4017 100644
--- a/hs/Util.hs
+++ b/hs/Util.hs
@@ -2,7 +2,7 @@ module Util
 ( accumulate
 , intersperse
 , joinBy
-, (&)
+-- , (&)
 , nullToMaybe
 , firstJust
 ) where
diff --git a/hs/vimwiki.cabal b/hs/vimwiki.cabal
index bf290f9..74d497b 100644
--- a/hs/vimwiki.cabal
+++ b/hs/vimwiki.cabal
@@ -27,6 +27,7 @@ executable Main
       -Wno-orphans
       -Wno-type-defaults
   other-modules:
+    Config,
     Files,
     Links,
     Html,
@@ -42,9 +43,12 @@ executable Main
     pandoc-types,
     text,
     containers,
+    config-ini,
+    optparse-applicative,
     blaze-markup,
     blaze-html,
     doctemplates,
+    lens,
     network-uri,
     pretty-show,
     extra