-----------------------------------------------------------------------------
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.String
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- The 'MisoString' type and its conversion type classes.
--
-- 'MisoString' is a platform-conditional alias:
--
-- * On the client (WASM \/ GHC JS backend) it is @JSString@ — a zero-copy
--   wrapper around a native JavaScript string, giving optimal interop with
--   the DOM and JSON APIs.
-- * On the server (@VANILLA@ build) it is 'Data.Text.Text', enabling
--   server-side rendering without any FFI dependency.
--
-- Use 'ms' (short for 'toMisoString') to convert from 'String', 'T.Text',
-- numeric types, etc. into 'MisoString'.
----------------------------------------------------------------------------
module Miso.String
  ( ToMisoString (..)
  , FromMisoString (..)
  , fromMisoString
  , MisoString
#ifdef VANILLA
  , module Data.Text
#else
  , module Data.JSString
#endif
  , ms
  ) where
----------------------------------------------------------------------------
import           Control.Exception
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
#ifdef VANILLA
import           Data.Text hiding (show, elem)
#else
import           Data.JSString
#ifdef GHCJS_BOTH
import           Data.JSString.Text
#endif
#endif
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
----------------------------------------------------------------------------
import           Miso.DSL.FFI
----------------------------------------------------------------------------
-- | The primary string type in Miso applications.
--
-- * @VANILLA@ (server\/SSR build): alias for 'Data.Text.Text'
-- * WASM \/ GHC JS backend: alias for @JSString@ — a zero-copy wrapper around
--   a native JavaScript string, giving optimal interop with the DOM and JSON APIs
--
#ifdef VANILLA
type MisoString = Text
#else
type MisoString = JSString
#endif
----------------------------------------------------------------------------
-- | A type that can be converted to 'MisoString'.
--
-- Instances are provided for 'String', 'T.Text', 'LT.Text', 'B.ByteString',
-- 'BL.ByteString', 'Double', 'Float', 'Int', 'Word', and others.
-- Use 'ms' as a short alias for 'toMisoString'.
class ToMisoString str where
  -- | Convert a value to 'MisoString'.
  toMisoString :: str -> MisoString
----------------------------------------------------------------------------
-- | A type that can be parsed from a 'MisoString'.
-- Like a safe 'Read' that returns an error message on failure.
class FromMisoString t where
  -- | Parse a 'MisoString', returning @'Left' errMsg@ on failure.
  fromMisoStringEither :: MisoString -> Either String t
----------------------------------------------------------------------------
-- | Parse a 'MisoString', throwing an error on failure.
-- Use 'fromMisoStringEither' as a safe alternative.
fromMisoString :: FromMisoString a => MisoString -> a
fromMisoString :: forall a. FromMisoString a => MisoString -> a
fromMisoString MisoString
s =
  case MisoString -> Either [Char] a
forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither MisoString
s of
    Left [Char]
error_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"fromMisoString: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
error_)
    Right a
x  -> a
x
----------------------------------------------------------------------------
-- | Short alias for 'toMisoString'. The idiomatic way to construct a 'MisoString'.
ms :: ToMisoString str => str -> MisoString
ms :: forall str. ToMisoString str => str -> MisoString
ms = str -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
----------------------------------------------------------------------------
instance ToMisoString a => ToMisoString (Maybe a) where
  toMisoString :: Maybe a -> MisoString
toMisoString = \case
    Maybe a
Nothing -> MisoString
forall a. Monoid a => a
mempty
    Just a
x -> a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms a
x
----------------------------------------------------------------------------
instance ToMisoString Char where
  toMisoString :: Char -> MisoString
toMisoString = Char -> MisoString
singleton
----------------------------------------------------------------------------
instance ToMisoString IOException where
  toMisoString :: IOException -> MisoString
toMisoString = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString)
-> (IOException -> [Char]) -> IOException -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> [Char]
forall a. Show a => a -> [Char]
show
----------------------------------------------------------------------------
#ifndef VANILLA
instance ToMisoString MisoString where
  toMisoString = id
#endif
----------------------------------------------------------------------------
instance ToMisoString SomeException where
  toMisoString :: SomeException -> MisoString
toMisoString = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString)
-> (SomeException -> [Char]) -> SomeException -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show
----------------------------------------------------------------------------
instance ToMisoString String where
  toMisoString :: [Char] -> MisoString
toMisoString = [Char] -> MisoString
pack
----------------------------------------------------------------------------
instance ToMisoString LT.Text where
  toMisoString :: Text -> MisoString
toMisoString = MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (MisoString -> MisoString)
-> (Text -> MisoString) -> Text -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MisoString
LT.toStrict
----------------------------------------------------------------------------
instance ToMisoString T.Text where
#ifdef VANILLA
  toMisoString :: MisoString -> MisoString
toMisoString = MisoString -> MisoString
forall a. a -> a
id
#else
  toMisoString = textToJSString
#endif
----------------------------------------------------------------------------
instance ToMisoString B.ByteString where
  toMisoString :: ByteString -> MisoString
toMisoString = MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (MisoString -> MisoString)
-> (ByteString -> MisoString) -> ByteString -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MisoString
T.decodeUtf8
----------------------------------------------------------------------------
instance ToMisoString BL.ByteString where
  toMisoString :: ByteString -> MisoString
toMisoString = Text -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Text -> MisoString)
-> (ByteString -> Text) -> ByteString -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8
----------------------------------------------------------------------------
instance ToMisoString B.Builder where
  toMisoString :: Builder -> MisoString
toMisoString = ByteString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (ByteString -> MisoString)
-> (Builder -> ByteString) -> Builder -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString
----------------------------------------------------------------------------
instance ToMisoString Float where
  -- dmj: issue where Float shows additional digits (affects both JS & WASM)
  toMisoString :: Float -> MisoString
toMisoString = Double -> MisoString
toString_Double (Double -> MisoString) -> (Float -> Double) -> Float -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
instance ToMisoString Double where
  toMisoString :: Double -> MisoString
toMisoString = Double -> MisoString
toString_Double
----------------------------------------------------------------------------
instance ToMisoString Int where
  toMisoString :: Int -> MisoString
toMisoString = Int -> MisoString
toString_Int
----------------------------------------------------------------------------
instance ToMisoString Word where
  toMisoString :: Word -> MisoString
toMisoString = Word -> MisoString
toString_Word
----------------------------------------------------------------------------
#ifndef VANILLA
instance FromMisoString MisoString where
  fromMisoStringEither = Right
#endif
----------------------------------------------------------------------------
instance FromMisoString T.Text where
#ifdef VANILLA
  fromMisoStringEither :: MisoString -> Either [Char] MisoString
fromMisoStringEither = MisoString -> Either [Char] MisoString
forall a b. b -> Either a b
Right
#else
  fromMisoStringEither = Right . textFromJSString
#endif
----------------------------------------------------------------------------
instance FromMisoString String where
  fromMisoStringEither :: MisoString -> Either [Char] [Char]
fromMisoStringEither = [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> Either [Char] [Char])
-> (MisoString -> [Char]) -> MisoString -> Either [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> [Char]
unpack
----------------------------------------------------------------------------
instance FromMisoString LT.Text where
#ifdef VANILLA
  fromMisoStringEither :: MisoString -> Either [Char] Text
fromMisoStringEither = Text -> Either [Char] Text
forall a b. b -> Either a b
Right (Text -> Either [Char] Text)
-> (MisoString -> Text) -> MisoString -> Either [Char] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Text
LT.fromStrict
#else
  fromMisoStringEither = Right . LT.fromStrict . textFromJSString
#endif
----------------------------------------------------------------------------
instance FromMisoString B.ByteString where
  fromMisoStringEither :: MisoString -> Either [Char] ByteString
fromMisoStringEither = (MisoString -> ByteString)
-> Either [Char] MisoString -> Either [Char] ByteString
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MisoString -> ByteString
T.encodeUtf8 (Either [Char] MisoString -> Either [Char] ByteString)
-> (MisoString -> Either [Char] MisoString)
-> MisoString
-> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Either [Char] MisoString
forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString BL.ByteString where
  fromMisoStringEither :: MisoString -> Either [Char] ByteString
fromMisoStringEither = (Text -> ByteString)
-> Either [Char] Text -> Either [Char] ByteString
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
LT.encodeUtf8 (Either [Char] Text -> Either [Char] ByteString)
-> (MisoString -> Either [Char] Text)
-> MisoString
-> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Either [Char] Text
forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString B.Builder where
  fromMisoStringEither :: MisoString -> Either [Char] Builder
fromMisoStringEither = (ByteString -> Builder)
-> Either [Char] ByteString -> Either [Char] Builder
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
B.byteString (Either [Char] ByteString -> Either [Char] Builder)
-> (MisoString -> Either [Char] ByteString)
-> MisoString
-> Either [Char] Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Either [Char] ByteString
forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString Word where
  fromMisoStringEither :: MisoString -> Either [Char] Word
fromMisoStringEither MisoString
string =
    case MisoString -> Maybe Word
parseWord MisoString
string of
      Maybe Word
Nothing -> [Char] -> Either [Char] Word
forall a b. a -> Either a b
Left ([Char]
"fromMisoString Word: could not parse " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MisoString -> [Char]
unpack MisoString
string)
      Just Word
x -> Word -> Either [Char] Word
forall a b. b -> Either a b
Right Word
x
----------------------------------------------------------------------------
instance FromMisoString Double where
  fromMisoStringEither :: MisoString -> Either [Char] Double
fromMisoStringEither MisoString
string =
    case MisoString -> Maybe Double
parseDouble MisoString
string of
      Maybe Double
Nothing -> [Char] -> Either [Char] Double
forall a b. a -> Either a b
Left ([Char]
"fromMisoString Double: could not parse " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MisoString -> [Char]
unpack MisoString
string)
      Just Double
x -> Double -> Either [Char] Double
forall a b. b -> Either a b
Right Double
x
----------------------------------------------------------------------------
instance FromMisoString Int where
  fromMisoStringEither :: MisoString -> Either [Char] Int
fromMisoStringEither MisoString
string =
    case MisoString -> Maybe Int
parseInt MisoString
string of
      Maybe Int
Nothing -> [Char] -> Either [Char] Int
forall a b. a -> Either a b
Left ([Char]
"fromMisoString Int: could not parse " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MisoString -> [Char]
unpack MisoString
string)
      Just Int
x -> Int -> Either [Char] Int
forall a b. b -> Either a b
Right Int
x
----------------------------------------------------------------------------
instance FromMisoString Float where
  fromMisoStringEither :: MisoString -> Either [Char] Float
fromMisoStringEither MisoString
string =
    case MisoString -> Maybe Float
parseFloat MisoString
string of
      Maybe Float
Nothing -> [Char] -> Either [Char] Float
forall a b. a -> Either a b
Left ([Char]
"fromMisoString Float: could not parse " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MisoString -> [Char]
unpack MisoString
string)
      Just Float
x -> Float -> Either [Char] Float
forall a b. b -> Either a b
Right Float
x
----------------------------------------------------------------------------