{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- spec: spec/modules/Simplex/Messaging/Parsers.md
module Simplex.Messaging.Parsers
  ( base64P,
    parse,
    parseAll,
    parseE,
    parseE',
    parseRead1,
    parseString,
    fstToLower,
    dropPrefix,
    enumJSON,
    sumTypeJSON,
    taggedObjectJSON,
    singleFieldJSON,
    singleFieldJSON_,
    defaultJSON,
    textP,
    pattern SingleFieldJSONTag,
    pattern TaggedObjectJSONTag,
    pattern TaggedObjectJSONData,
  ) where

import Control.Monad.Trans.Except
import qualified Data.Aeson as J
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import Data.ByteString.Base64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (isAlphaNum, toLower)
import Data.String
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Data.Time.ISO8601 (parseISO8601)
import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
import Text.Read (readMaybe)

base64P :: Parser ByteString
base64P = decode <$?> paddedBase64 rawBase64P

paddedBase64 :: Parser ByteString -> Parser ByteString
paddedBase64 raw = (<>) <$> raw <*> pad
  where
    pad = A.takeWhile (== '=')

rawBase64P :: Parser ByteString
rawBase64P = A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')

-- rawBase64UriP :: Parser ByteString
-- rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')

tsISO8601P :: Parser UTCTime
tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd

parse :: Parser a -> e -> (ByteString -> Either e a)
parse parser err = first (const err) . parseAll parser

parseAll :: Parser a -> (ByteString -> Either String a)
parseAll parser = A.parseOnly (parser <* A.endOfInput)

parseE :: (String -> e) -> Parser a -> (ByteString -> ExceptT e IO a)
parseE err parser = except . first err . parseAll parser

parseE' :: (String -> e) -> Parser a -> (ByteString -> ExceptT e IO a)
parseE' err parser = except . first err . A.parseOnly parser

parseRead :: Read a => Parser ByteString -> Parser a
parseRead = (>>= maybe (fail "cannot read") pure . readMaybe . B.unpack)

parseRead1 :: Read a => Parser a
parseRead1 = parseRead $ A.takeTill wordEnd

parseRead2 :: Read a => Parser a
parseRead2 = parseRead $ do
  w1 <- A.takeTill wordEnd <* A.char ' '
  w2 <- A.takeTill wordEnd
  pure $ w1 <> " " <> w2

wordEnd :: Char -> Bool
wordEnd c = c == ' ' || c == '\n'
{-# INLINE wordEnd #-}

parseString :: (ByteString -> Either String a) -> (String -> a)
parseString p = either error id . p . B.pack

fstToLower :: String -> String
fstToLower "" = ""
fstToLower (h : t) = toLower h : t

dropPrefix :: String -> String -> String
dropPrefix pfx s =
  let (p, rest) = splitAt (length pfx) s
   in fstToLower $ if p == pfx then rest else s

enumJSON :: (String -> String) -> J.Options
enumJSON tagModifier =
  J.defaultOptions
    { J.constructorTagModifier = tagModifier,
      J.allNullaryToStringTag = True
    }

-- spec: spec/modules/Simplex/Messaging/Parsers.md#sumTypeJSON
-- Platform-dependent: ObjectWithSingleField on Darwin+swiftJSON, TaggedObject elsewhere
sumTypeJSON :: (String -> String) -> J.Options
#if defined(darwin_HOST_OS) && defined(swiftJSON)
sumTypeJSON = singleFieldJSON_ $ Just SingleFieldJSONTag
#else
sumTypeJSON = taggedObjectJSON
#endif

pattern SingleFieldJSONTag :: (Eq a, IsString a) => a
pattern SingleFieldJSONTag = "_owsf"

taggedObjectJSON :: (String -> String) -> J.Options
taggedObjectJSON tagModifier =
  J.defaultOptions
    { J.sumEncoding = J.TaggedObject TaggedObjectJSONTag TaggedObjectJSONData,
      J.tagSingleConstructors = True,
      J.constructorTagModifier = tagModifier,
      J.allNullaryToStringTag = False,
      J.nullaryToObject = True,
      J.omitNothingFields = True
    }

pattern TaggedObjectJSONTag :: (Eq a, IsString a) => a
pattern TaggedObjectJSONTag = "type"

pattern TaggedObjectJSONData :: (Eq a, IsString a) => a
pattern TaggedObjectJSONData = "data"

-- used in platform independent encoding, doesn't include tag for single-field encoding of sum types
singleFieldJSON :: (String -> String) -> J.Options
singleFieldJSON = singleFieldJSON_ Nothing

singleFieldJSON_ :: Maybe String -> (String -> String) -> J.Options
singleFieldJSON_ objectTag tagModifier =
  J.defaultOptions
    { J.sumEncoding = J.ObjectWithSingleField objectTag,
      J.tagSingleConstructors = True,
      J.constructorTagModifier = tagModifier,
      J.allNullaryToStringTag = False,
      J.nullaryToObject = True,
      J.omitNothingFields = True
    }

defaultJSON :: J.Options
defaultJSON = J.defaultOptions {J.omitNothingFields = True}

textP :: Parser String
textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString