Allow custom siteurl/home for locopy

locopy/Locopy/CommandLine.hs

@@ -0,0 +1,44 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+module Locopy.CommandLine
+    ( CommandLine(..)
+    , Wordpress(..)
+    , commandLine
+    ) where
+
+import Options.Applicative
+    ( Parser
+    , ParserInfo(..)
+    , command
+    , header
+    , help
+    , hsubparser
+    , idm
+    , info
+    , long
+    , metavar
+    , strOption
+    )
+
+data Wordpress = Wordpress
+    { root :: FilePath
+    , siteurl :: String
+    }
+
+newtype CommandLine
+    = WordpressCommand Wordpress
+
+wordpress :: Parser CommandLine
+wordpress = fmap WordpressCommand
+    $ Wordpress
+    <$> strOption (long "root" <> metavar "ROOT" <> help "Website configuration directory")
+    <*> strOption (long "siteurl" <> metavar "HOME" <> help "siteurl and home address")
+
+commandLine :: ParserInfo CommandLine
+commandLine = info subcommand (header "locopy (wordpress) [OPTIONS]")
+  where
+    subcommand = hsubparser
+        ( command "wordpress" (info wordpress idm)
+        )

locopy/Locopy/Wordpress.hs

@@ -0,0 +1,71 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+module Locopy.Wordpress
+    ( wordpress
+    ) where
+
+import qualified Data.Aeson as Aeson
+import Data.Aeson.TH (deriveJSON)
+import Data.Word (Word16)
+import Data.Text (StrictText)
+import qualified Data.Text as StrictText
+import qualified Data.Text.Read as StrictText
+import Locopy.CommandLine (Wordpress(..))
+import System.Directory
+    ( withCurrentDirectory
+    , getCurrentDirectory
+    )
+import System.FilePath ((</>))
+import System.Process (readProcess)
+import Data.String (IsString(..))
+import Control.Monad (void)
+
+data WpConfig = WpConfig
+    { dbName :: StrictText
+    , dbUser :: StrictText
+    , dbPassword :: StrictText
+    , dbHost :: StrictText
+    , tablePrefix :: StrictText
+    } deriving (Eq, Show)
+
+$(deriveJSON Aeson.defaultOptions 'WpConfig)
+
+readConfiguration :: FilePath -> IO WpConfig
+readConfiguration root = do
+    currentDirectory <- getCurrentDirectory
+    let wpSettingsPath = currentDirectory </> "locopy" </> "wp-settings.php"
+    withCurrentDirectory root (readProcess "php" [wpSettingsPath] "")
+        >>= Aeson.throwDecodeStrict . fromString
+
+updateOptions :: String -> WpConfig -> IO ()
+updateOptions siteurl WpConfig{..} =
+    let query
+            = "UPDATE "
+            <> tablePrefix
+            <> "options SET option_value = '"
+            <> StrictText.pack siteurl
+            <> "' WHERE option_name IN ('siteurl', 'home')"
+     in void $ readProcess "mariadb"
+        ([ "--host=" <> StrictText.unpack dbHost
+        , "--user=" <> StrictText.unpack dbUser
+        , StrictText.unpack dbName
+        ] <> hostOptions (StrictText.splitOn ":" dbHost)) (StrictText.unpack query)
+  where
+    hostOptions [onlyHost] = ["--host=" <> StrictText.unpack onlyHost]
+    hostOptions [host, port]
+        | Right (portNumber, "") <- StrictText.decimal port =
+            [ "--host=" <> StrictText.unpack host
+            , "--port=" <> show (portNumber :: Word16)
+            ]
+        | otherwise =
+            [ "--host=" <> StrictText.unpack host
+            , "--socket=" <> StrictText.unpack port
+            ]
+    hostOptions _ = []
+
+wordpress :: Wordpress -> IO ()
+wordpress Wordpress{..}
+    = readConfiguration root
+    >>= updateOptions siteurl