packages feed

miso-1.12.0.0: src/Miso/String.hs

-----------------------------------------------------------------------------
{-# 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 s =
  case fromMisoStringEither s of
    Left error_ -> error ("fromMisoString: " <> error_)
    Right x  -> x
----------------------------------------------------------------------------
-- | Short alias for 'toMisoString'. The idiomatic way to construct a 'MisoString'.
ms :: ToMisoString str => str -> MisoString
ms = toMisoString
----------------------------------------------------------------------------
instance ToMisoString a => ToMisoString (Maybe a) where
  toMisoString = \case
    Nothing -> mempty
    Just x -> ms x
----------------------------------------------------------------------------
instance ToMisoString Char where
  toMisoString = singleton
----------------------------------------------------------------------------
instance ToMisoString IOException where
  toMisoString = ms . show
----------------------------------------------------------------------------
#ifndef VANILLA
instance ToMisoString MisoString where
  toMisoString = id
#endif
----------------------------------------------------------------------------
instance ToMisoString SomeException where
  toMisoString = ms . show
----------------------------------------------------------------------------
instance ToMisoString String where
  toMisoString = pack
----------------------------------------------------------------------------
instance ToMisoString LT.Text where
  toMisoString = ms . LT.toStrict
----------------------------------------------------------------------------
instance ToMisoString T.Text where
#ifdef VANILLA
  toMisoString = id
#else
  toMisoString = textToJSString
#endif
----------------------------------------------------------------------------
instance ToMisoString B.ByteString where
  toMisoString = ms . T.decodeUtf8
----------------------------------------------------------------------------
instance ToMisoString BL.ByteString where
  toMisoString = ms . LT.decodeUtf8
----------------------------------------------------------------------------
instance ToMisoString B.Builder where
  toMisoString = ms . B.toLazyByteString
----------------------------------------------------------------------------
instance ToMisoString Float where
  -- dmj: issue where Float shows additional digits (affects both JS & WASM)
  toMisoString = toString_Double . realToFrac
----------------------------------------------------------------------------
instance ToMisoString Double where
  toMisoString = toString_Double
----------------------------------------------------------------------------
instance ToMisoString Int where
  toMisoString = toString_Int
----------------------------------------------------------------------------
instance ToMisoString Word where
  toMisoString = toString_Word
----------------------------------------------------------------------------
#ifndef VANILLA
instance FromMisoString MisoString where
  fromMisoStringEither = Right
#endif
----------------------------------------------------------------------------
instance FromMisoString T.Text where
#ifdef VANILLA
  fromMisoStringEither = Right
#else
  fromMisoStringEither = Right . textFromJSString
#endif
----------------------------------------------------------------------------
instance FromMisoString String where
  fromMisoStringEither = Right . unpack
----------------------------------------------------------------------------
instance FromMisoString LT.Text where
#ifdef VANILLA
  fromMisoStringEither = Right . LT.fromStrict
#else
  fromMisoStringEither = Right . LT.fromStrict . textFromJSString
#endif
----------------------------------------------------------------------------
instance FromMisoString B.ByteString where
  fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString BL.ByteString where
  fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString B.Builder where
  fromMisoStringEither = fmap B.byteString . fromMisoStringEither
----------------------------------------------------------------------------
instance FromMisoString Word where
  fromMisoStringEither string =
    case parseWord string of
      Nothing -> Left ("fromMisoString Word: could not parse " <> unpack string)
      Just x -> Right x
----------------------------------------------------------------------------
instance FromMisoString Double where
  fromMisoStringEither string =
    case parseDouble string of
      Nothing -> Left ("fromMisoString Double: could not parse " <> unpack string)
      Just x -> Right x
----------------------------------------------------------------------------
instance FromMisoString Int where
  fromMisoStringEither string =
    case parseInt string of
      Nothing -> Left ("fromMisoString Int: could not parse " <> unpack string)
      Just x -> Right x
----------------------------------------------------------------------------
instance FromMisoString Float where
  fromMisoStringEither string =
    case parseFloat string of
      Nothing -> Left ("fromMisoString Float: could not parse " <> unpack string)
      Just x -> Right x
----------------------------------------------------------------------------