1
0
Files
kazbek/locopy/Locopy/Wordpress.hs

72 lines
2.3 KiB
Haskell

{- 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