Allow custom siteurl/home for locopy

9 files changed, 164 insertions, 147 deletions

diff --git a/Gemfile b/Gemfile
index d9886af..ef8fd67 100644
--- a/Gemfile
+++ b/Gemfile
@@ -3,8 +3,5 @@
 source 'https://rubygems.org'
 
 gem 'pg', '~> 1.6'
-
 gem 'rubyzip', '~> 3.2'
-
-gem 'optparse', '~> 0.8.0'
 gem 'term-ansicolor', '~> 1.11'
diff --git a/Gemfile.lock b/Gemfile.lock
index cafbdfe..2fdffc2 100644
--- a/Gemfile.lock
+++ b/Gemfile.lock
@@ -4,7 +4,6 @@ GEM
     bigdecimal (4.0.1)
     io-console (0.8.2)
     mize (0.6.1)
-    optparse (0.8.1)
     pg (1.6.2)
     pg (1.6.2-x86_64-linux)
     readline (0.0.4)
@@ -26,7 +25,6 @@ PLATFORMS
   x86_64-linux
 
 DEPENDENCIES
-  optparse (~> 0.8.0)
   pg (~> 1.6)
   rubyzip (~> 3.2)
   term-ansicolor (~> 1.11)
diff --git a/README.md b/README.md
index 33592b1..81e23a2 100644
--- a/README.md
+++ b/README.md
@@ -70,18 +70,15 @@ for the name with `.html` extension.
 ## locopy
 
 locopy updates Wordpress `siteurl` and `home` options and sets them to
-http://localhost:8083, so that the Wordpress instance can run locally.
+some address, so that the Wordpress instance can run locally.
 
 locopy reads Wordpress database configuration from the `wp-config.php` that
 it should be able to find. Invokation example:
 
 ```sh
-./locopy/locopy.rb wordpress --root /path/to/wordpress --dump=
+locopy wordpress --root /path/to/wordpress --siteurl "http://localhost:8083"
 ```
 
-The `--dump` option isn't currently used but should be present on the command
-line.
-
 ## tea-cleaner
 
 `tea-cleaner` tries to detect spam accounts on a gitea instance and can remove
diff --git a/kazbek.cabal b/kazbek.cabal
index a22dee4..74d7f2a 100644
--- a/kazbek.cabal
+++ b/kazbek.cabal
@@ -11,31 +11,45 @@ build-type: Simple
 
 common warnings
     ghc-options: -Wall
-
-executable tea-cleaner
-    import: warnings
-    main-is: Main.hs
     default-extensions:
         TemplateHaskell,
         OverloadedStrings,
         QuasiQuotes,
         DuplicateRecordFields,
         RecordWildCards
+    default-language: GHC2024
+    build-depends:
+        aeson ^>= 2.2.3,
+        base >= 4.20 && < 5,
+        bytestring ^>= 0.12.2,
+        text ^>= 2.1
+
+executable tea-cleaner
+    import: warnings
+    main-is: Main.hs
     other-modules:
         TeaCleaner.Client
         TeaCleaner.Configuration
         TeaCleaner.Filter
         TeaCleaner.Options
     build-depends:
-        aeson ^>= 2.2.3,
-        base >= 4.20 && < 5,
-        bytestring ^>= 0.12.2,
         modern-uri ^>= 0.3.6,
         optparse-applicative ^>= 0.19.0,
         req ^>= 3.13,
         time >= 1.9 && < 2,
-        text ^>= 2.1,
         tomland ^>= 1.3.3,
         vector ^>= 0.13.2
     hs-source-dirs: tea-cleaner
-    default-language: GHC2024
+
+executable locopy
+    import: warnings
+    main-is: Main.hs
+    hs-source-dirs: locopy
+    other-modules:
+        Locopy.CommandLine
+        Locopy.Wordpress
+    build-depends:
+        directory ^>= 1.3.9,
+        filepath ^>= 1.5.4,
+        optparse-applicative ^>= 0.19,
+        process ^>= 1.6.26
diff --git a/locopy/Locopy/CommandLine.hs b/locopy/Locopy/CommandLine.hs
new file mode 100644
index 0000000..0146cc9
--- /dev/null
+++ b/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)
+        )
diff --git a/locopy/Locopy/Wordpress.hs b/locopy/Locopy/Wordpress.hs
new file mode 100644
index 0000000..0587624
--- /dev/null
+++ b/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
diff --git a/locopy/Main.hs b/locopy/Main.hs
new file mode 100644
index 0000000..98fd079
--- /dev/null
+++ b/locopy/Main.hs
@@ -0,0 +1,19 @@
+{- 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 Main
+    ( main
+    ) where
+
+import Options.Applicative (execParser)
+import Locopy.Wordpress (wordpress)
+import Locopy.CommandLine
+    ( commandLine
+    , CommandLine(..)
+    )
+
+main :: IO ()
+main = execParser commandLine >>= withCommandLine
+  where
+    withCommandLine (WordpressCommand options) = wordpress options
diff --git a/locopy/locopy.rb b/locopy/locopy.rb
deleted file mode 100755
index 0bd48a3..0000000
--- a/locopy/locopy.rb
+++ /dev/null
@@ -1,123 +0,0 @@
-#!/usr/bin/env ruby
-# 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/.
-
-# frozen_string_literal: true
-
-require 'pathname'
-require 'mysql2'
-require 'optparse'
-require 'json'
-require 'term/ansicolor'
-
-# Tool for easy updating a local copy of a website
-
-class DatabaseAccess
-  attr_accessor :name, :user, :password
-  attr_reader :host, :socket, :port
-
-  def initialize(wp_config)
-    @name = wp_config['DB_NAME']
-    @user = wp_config['DB_USER']
-    @password = wp_config['DB_PASSWORD']
-
-    self.host = wp_config['DB_HOST']
-  end
-
-  def host=(host)
-    host_part, socket_part = host.split(':')
-    port = socket_part.to_i
-
-    @host = host_part
-    if port == 0
-      @socket = socket_part
-    else
-      @port = port
-    end
-  end
-end
-
-def copy_db(wp_config)
-  table_prefix = wp_config['table_prefix']
-  php_constants = DatabaseAccess.new wp_config
-  keep_option_names = ['siteurl', 'home']
-
-  client = Mysql2::Client.new host: php_constants.host, username: php_constants.user,
-    password: php_constants.password, database: php_constants.name, socket: php_constants.socket
-  statement = client.prepare <<~SQL
-    SELECT option_name, option_value
-    FROM #{table_prefix}options
-    WHERE option_name LIKE ?
-  SQL
-  keep_option_values = keep_option_names.each_with_object({}) do |keep_option_name, accumulator|
-    accumulator[keep_option_name] = statement.execute(keep_option_name).first['option_value']
-    accumulator
-  end
-  keep_option_values = {
-    'siteurl' => 'http://localhost:8083',
-    'home' => 'http://localhost:8083'
-  }
-
-  statement = client.prepare <<~SQL
-    UPDATE #{table_prefix}options
-    SET option_value = ?
-    WHERE option_name LIKE ?
-  SQL
-  keep_option_values.each_pair do |name, value|
-    statement.execute(value, name)
-  end
-end
-
-class CommandOptions
-  attr_reader :root, :dump
-
-  def []=(key, value)
-    case key
-    when :root
-      @root = Pathname.new value
-    when :dump
-      @dump = Pathname.new value
-    end
-  end
-
-  def valid?
-    !@root.nil? && !@dump.nil?
-  end
-end
-
-def wordpress
-  arguments = CommandOptions.new
-  option_parser = OptionParser.new do |options|
-    options.banner = "Usage: #{File.basename $0} [OPTIONS] (wordpress)"
-
-    options.on '--root=ROOT', 'Website configuration directory'
-    options.on '--dump=DUMP', 'Database file'
-  end
-
-  option_parser.parse!(into: arguments)
-  unless arguments.valid?
-    $stderr.puts option_parser.help
-    exit 2
-  end
-
-  wp_settings = Pathname.new('locopy/wp-settings.php').realpath
-  wp_config = nil
-
-  Dir.chdir arguments.root do
-    wp_config = JSON.parse `php #{wp_settings}`
-  end
-
-  copy_db wp_config
-end
-
-# Check for supported command.
-command = ARGV.shift
-case command
-when 'wordpress'
-  wordpress
-when nil
-  Kernel.abort Term::ANSIColor.red "No command given at the command line."
-else
-  Kernel.abort Term::ANSIColor.red %Q(Unsupported command "#{command}".)
-end
diff --git a/locopy/wp-settings.php b/locopy/wp-settings.php
index 42aec0e..c35e8ed 100644
--- a/locopy/wp-settings.php
+++ b/locopy/wp-settings.php
@@ -4,9 +4,9 @@ define('ABSPATH', __DIR__ . '/');
 require_once 'wp-config.php';
 
 echo json_encode([
-    'DB_NAME' => DB_NAME,
-    'DB_USER' => DB_USER,
-    'DB_PASSWORD' => DB_PASSWORD,
-    'DB_HOST' => DB_HOST,
-    'table_prefix' => $table_prefix
+    'dbName' => DB_NAME,
+    'dbUser' => DB_USER,
+    'dbPassword' => DB_PASSWORD,
+    'dbHost' => DB_HOST,
+    'tablePrefix' => $table_prefix
 ]);