content: --------------------------------------------------------------------------------
  {-# LANGUAGE LambdaCase      #-}
  {-# LANGUAGE TemplateHaskell #-}
  module Patat.Images.W3m
      ( backend
      ) where
  
  
  --------------------------------------------------------------------------------
  import           Control.Exception      (IOException, throwIO, try)
  import           Control.Monad          (unless, void)
  import qualified Data.Aeson.TH.Extended as A
  import           Data.List              (intercalate)
  import           Patat.Cleanup          (Cleanup)
  import qualified Patat.Images.Internal  as Internal
  import qualified System.Directory       as Directory
  import qualified System.Process         as Process
  import           Text.Read              (readMaybe)
  
  
  --------------------------------------------------------------------------------
  data Config = Config
      { cPath :: Maybe FilePath
      } deriving (Show)
  
  
  --------------------------------------------------------------------------------
  $(A.deriveFromJSON A.dropPrefixOptions ''Config)
  
  
  --------------------------------------------------------------------------------
  backend :: Internal.Backend
  backend = Internal.Backend new
  
  
  --------------------------------------------------------------------------------
  new :: Internal.Config Config -> IO Internal.Handle
  new config = do
      w3m <- findW3m $ case config of
          Internal.Explicit c -> cPath c
          _                   -> Nothing
  
      return Internal.Handle {Internal.hDrawImage = drawImage w3m}
  
  
  --------------------------------------------------------------------------------
  newtype W3m = W3m FilePath deriving (Show)
  
  
  --------------------------------------------------------------------------------
  findW3m :: Maybe FilePath -> IO W3m
  findW3m = \case
      -- Use the path specified by the user.
      Just path -> do
          exe <- isExecutable path
          if exe
              then pure $ W3m path
              else throwIO $
                      Internal.BackendNotSupported $ path ++ " is not executable"
  
      Nothing -> do
          let path = W3m "w3mimgdisplay"
          errOrSize <- try $ getTerminalSize path
          case errOrSize :: Either IOException (Int, Int) of
              Right _ -> pure path          -- Found it.
              Left _ -> W3m <$> find paths  -- Look in some hardcoded paths.
    where
      find []       = throwIO $ Internal.BackendNotSupported
          "w3mimgdisplay executable not found"
      find (p : ps) = do
          exe <- isExecutable p
          if exe then return p else find ps
  
      paths =
          [ "/usr/lib/w3m/w3mimgdisplay"
          , "/usr/libexec/w3m/w3mimgdisplay"
          , "/usr/lib64/w3m/w3mimgdisplay"
          , "/usr/libexec64/w3m/w3mimgdisplay"
          , "/usr/local/libexec/w3m/w3mimgdisplay"
          ]
  
      isExecutable path = do
          exists <- Directory.doesFileExist path
          if exists then do
              perms <- Directory.getPermissions path
              return (Directory.executable perms)
          else
              return False
  
  
  --------------------------------------------------------------------------------
  -- | Parses something of the form "<width> <height>\n".
  parseWidthHeight :: String -> Maybe (Int, Int)
  parseWidthHeight output = case words output of
      [ws, hs] | Just w <- readMaybe ws, Just h <- readMaybe hs ->
          return (w, h)
      _  -> Nothing
  
  
  --------------------------------------------------------------------------------
  getTerminalSize :: W3m -> IO (Int, Int)
  getTerminalSize (W3m w3mPath) = do
      output <- Process.readProcess w3mPath ["-test"] ""
      case parseWidthHeight output of
          Just wh -> return wh
          _       -> fail $
              "Patat.Images.W3m.getTerminalSize: " ++
              "Could not parse `w3mimgdisplay -test` output"
  
  
  --------------------------------------------------------------------------------
  getImageSize :: W3m -> FilePath -> IO (Int, Int)
  getImageSize (W3m w3mPath) path = do
      output <- Process.readProcess w3mPath [] ("5;" ++ path ++ "\n")
      case parseWidthHeight output of
          Just wh -> return wh
          _       -> fail $
              "Patat.Images.W3m.getImageSize: " ++
              "Could not parse image size using `w3mimgdisplay` for " ++
              path
  
  
  --------------------------------------------------------------------------------
  drawImage :: W3m -> FilePath -> IO Cleanup
  drawImage w3m@(W3m w3mPath) path = do
      exists <- Directory.doesFileExist path
      unless exists $ fail $
          "Patat.Images.W3m.drawImage: file does not exist: " ++ path
  
      tsize <- getTerminalSize w3m
      isize <- getImageSize w3m path
      let (x, y, w, h) = fit tsize isize
          command =
              "0;1;" ++
              show x ++ ";" ++ show y ++ ";" ++ show w ++ ";" ++ show h ++
              ";;;;;" ++ path ++ "\n4;\n3;\n"
  
      -- Draw image.
      _ <- Process.readProcess w3mPath [] command
  
      -- Return a 'Cleanup' that clears the image.
      return $ void $ Process.readProcess w3mPath [] $
          "6;" ++ intercalate ";" (map show [x, y, w, h])
    where
      fit :: (Int, Int) -> (Int, Int) -> (Int, Int, Int, Int)
      fit (tw, th) (iw0, ih0) =
          -- Scale down to width
          let iw1 = if iw0 > tw then tw else iw0
              ih1 = if iw0 > tw then ((ih0 * tw) `div` iw0) else ih0
  
          -- Scale down to height
              iw2 = if ih1 > th then ((iw1 * th) `div` ih1) else iw1
              ih2 = if ih1 > th then th else ih1
  
          -- Find position
              x = (tw - iw2) `div` 2
              y = (th - ih2) `div` 2 in
  
           (x, y, iw2, ih2)
  