-----------------------------------------------------------------------------
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.String
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
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
----------------------------------------------------------------------------
-- | An efficient string type when building miso applications
--
-- t'MisoString' is t'Text' when prerendering
-- t'MisoString' is a JavaScript string when using the JS/WASM backends
--
#ifdef VANILLA
type MisoString = Text
#else
type MisoString = JSString
#endif
----------------------------------------------------------------------------
-- | Convenience class for creating `MisoString` from other string-like types
class ToMisoString str where
  -- | Convert a type into 'MisoString'
  toMisoString :: str -> MisoString
----------------------------------------------------------------------------
-- | Class used to parse a 'MisoString'. Like a safe 'Read' for 'MisoString'
class FromMisoString t where
  fromMisoStringEither :: MisoString -> Either String t
----------------------------------------------------------------------------
-- | Reads a 'MisoString', throws an error when decoding
-- fails. 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
----------------------------------------------------------------------------
-- | Convenience function, shorthand for `toMisoString`
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
----------------------------------------------------------------------------