module Misc where

import Control.Monad
import Data.ByteString.Lazy qualified as LazyBS
import Data.Char (isAlphaNum, isAscii, toLower)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Time
import System.Console.GetOpt qualified as GetOpt
import System.Directory qualified as Dir
import System.Environment
import System.Exit
import Text.Pandoc.Definition

-- | exception on 'Left'
unwrap :: Show a => FilePath -> Either a b -> IO b
unwrap file = either (\x -> fail $ file <> ":" <> show x) return

-- | @getOptionsWith hdr start opts@:
--
-- * calls 'getOpt' on the command line arguments
-- * if there are no unrecognised flags, calls 'start' on the non-option
--   arguments, and then applies the functions from the options to the result of
--   that
-- * otherwise it shows a usage message where the header is 'hdr' applied to the
--   executable name
getOptionsWith :: (String -> String) -> ([String] -> Maybe a)
               -> [GetOpt.OptDescr (a -> a)] -> IO a
getOptionsWith hdr mkDef descrs = do
  res <- GetOpt.getOpt GetOpt.Permute descrs <$> getArgs
  case res of
    (fs, rest, []) | Just def <- mkDef rest ->
      return $ foldl (flip ($)) def fs
    _ -> do
      prog <- getProgName
      putStrLn $ GetOpt.usageInfo (hdr prog) descrs
      exitFailure

-- | makes a url slug by:
--
-- * replacing all sequences of non-ascii or non-alphanumeric characters with
--   @"-"@
-- * lowercasing all (ascii) letters
makeSlug :: Text -> Text
makeSlug = Text.intercalate "-" . filter (not . Text.null) . chunks where
  chunks txt =
    if Text.null txt then [] else
    let (this', that') = Text.span isOK txt
        this = Text.map toLower this'
        that = Text.dropWhile (not . isOK) that' in
    this : chunks that
  isOK c = (isAlphaNum c && isAscii c) || c == '-'


-- | tries to convert a meta value to a list of strings
toTextList :: MetaValue -> Maybe [Text]
toTextList (MetaList vs) =  traverse toText vs
toTextList _ = Nothing

-- | tries to convert a meta value to a single string
toText :: MetaValue -> Maybe Text
toText (MetaString str) = Just str
toText (MetaInlines is) = foldMap inlineText is
toText (MetaBlocks bs) = foldMap blockText bs
toText _ = Nothing

-- | converts a pandoc inline into a string, if it contains only text.
inlineText :: Inline -> Maybe Text
inlineText (Str txt)         = Just txt
inlineText Space             = Just " "
inlineText SoftBreak         = Just " "
inlineText LineBreak         = Just " "
inlineText (RawInline _ txt) = Just txt
inlineText _                 = Nothing

-- | converts a pandoc inline into a string, if it contains only paragraphs of
-- text.
blockText :: Block -> Maybe Text
blockText (Plain is)       = foldMap inlineText is
blockText (Para  is)       = foldMap (fmap (<> "\n\n") . inlineText) is
blockText (RawBlock _ txt) = Just txt
blockText _                = Nothing


-- | date in YYYY-MM-DD format
newtype IsoDate = ID Day deriving (Eq, Ord)

-- | actually allows one-digit months and days
parseIsoDate :: MonadFail f => Text -> f IsoDate
parseIsoDate =
  fmap ID . parseTimeM True defaultTimeLocale "%Y-%-m-%-d" . Text.unpack


-- | formats a date in the RSS format, e.g. @Mon, 09 Sep 2024 00:00:01 UT@
rssDate :: IsoDate -> Text
rssDate (ID d) =
  Text.pack $ formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d

-- | formats a date in a format i like, e.g. @mon 9 sep 2024@
showDate :: IsoDate -> Text
showDate (ID d) =
  Text.pack $ toLower <$> formatTime defaultTimeLocale "%a %-d %B %Y" d

writeIfDifferentBS :: FilePath -> LazyBS.ByteString -> IO ()
writeIfDifferentBS fn content = do
  exists <- Dir.doesFileExist fn
  old <- if exists then Just <$> LazyBS.readFile fn else pure Nothing
  unless (old == Just content) $ LazyBS.writeFile fn content

writeIfDifferentT :: FilePath -> Text -> IO ()
writeIfDifferentT fn content = do
  exists <- Dir.doesFileExist fn
  old <- if exists then Just <$> Text.readFile fn else pure Nothing
  unless (old == Just content) $ Text.writeFile fn content