{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK prune #-}

{- |
Quite frequently you will find yourself needing to convert between a rich
semantic Haskell data type and a textual representation of that type which we
call the /external/ representation of a value. The external representation of
the value is authoriative and is meant to be re-readable even in the face of
changing implemetations on the program side.

Note that /externalizing/ is not quite the same as /serializing/. If you have
more complex (ie rich types or nested) data structures then a simple text
string will probably not be sufficient to convey sufficient information to
represent it accurately. Serializing is focused on both performance encoding
and decoding, and efficiency of the representation when transmitted over the
wire. Of course, the obvious benefits of efficiency didn't stop the entire
computer industry from near universal adoption of JSON as an interchange
format, so there is, perhaps, no hope for us.

You can, however, regain some of your sanity by ensuring that the individual
fields of a larger structure are safe, and that's where the externalizing
machinery in this module comes in.

If you have read this far and think we are describing something similar to
'Show' or @toString@ you are correct, but at the level of primative and simple
types we are providing the ability to marshall them to a clean UTF-8
representation and to unmarshall them back into Haskell values again.

The other major use case for this module is as a helper to read user input;
see 'Core.Program.Execute.queryOptionValue'' for an example that makes use of
this.

/Notes for implementators/

Postel's dictum to \"be conservative in what you produce but liberal in what
you accept\" describes the intent of this module. If you are implementing an
instance of 'Externalize' then you might consider being flexible as possible
when parsing with 'parseExternal', within the constraints of having to read a
given value with exact fidelity. But when outputing a value with
'formatExternal' you should be correcting the representation of the value to a
canonical, stable form, even if the original input was written differently.
See the discussion of creating 'Core.Data.Clock.Time' types from varying
inputs for an example.
-}
module Core.Encoding.External (
    -- * Conversions
    Externalize (formatExternal, parseExternal),
) where

import Core.Data.Clock
import Core.Text.Rope
import Data.ByteString.Builder qualified as Builder
import Data.Int (Int32, Int64)
import Data.Scientific (FPFormat (Exponent), Scientific, formatScientific)
import Data.UUID qualified as Uuid (UUID, fromText, toText)
import Text.Read (readMaybe)

{- |
Convert between the internal Haskell representation of a data type and an
external, textual form suitable for visualization, onward transmission, or
archival storage.

It is expected that a valid instance of 'Externalize' allows you to round-trip
through it:

>>> formatExternal (42 :: Int))
"42"

>>> fromJust (parseExternal "42") :: Int
42

with the usual caveat about needing to ensure you've given enough information
to the type-checker to know which instance you're asking for.

There is a general implementatation that goes though 'Show' and 'Read' via
'String' but if you know you have a direct way to render or parse a type into
a sequence of characters then you can offer an instance of 'Externalize' which
does so more efficiently.

@since 0.3.4
-}
class Externalize ξ where
    -- | Convert a value into an authoritative, stable textual representation
    -- for use externally.
    formatExternal :: ξ -> Rope

    -- | Attempt to read an external textual representation into a Haskell value.
    parseExternal :: Rope -> Maybe ξ

--
-- We use this general instance here rather than as a super class constraint
-- for Externalize so as to allow us to have things that can be externalized
-- without necessarily needing those two instances. Most things have Show, but
-- not everything, as many many types haven't bothered with Read.
--

instance {-# OVERLAPPABLE #-} (Read a, Show a) => Externalize a where
    formatExternal :: a -> Rope
formatExternal = String -> Rope
forall α. Textual α => α -> Rope
intoRope (String -> Rope) -> (a -> String) -> a -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
    parseExternal :: Rope -> Maybe a
parseExternal = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Rope -> String) -> Rope -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

instance Externalize Rope where
    formatExternal :: Rope -> Rope
formatExternal = Rope -> Rope
forall a. a -> a
id
    parseExternal :: Rope -> Maybe Rope
parseExternal = Rope -> Maybe Rope
forall a. a -> Maybe a
Just

instance Externalize String where
    formatExternal :: String -> Rope
formatExternal = String -> Rope
packRope
    parseExternal :: Rope -> Maybe String
parseExternal = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Rope -> String) -> Rope -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

--
-- These weren't really necessary, but they're worth it as an example of
-- avoiding Show & Read
--

{- |
Integers are represented in decimal:

@
42
@
-}
instance Externalize Int where
    formatExternal :: Int -> Rope
formatExternal = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Int -> ByteString) -> Int -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
Builder.intDec
    parseExternal :: Rope -> Maybe Int
parseExternal = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Rope -> String) -> Rope -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

{- |
Integers are represented in decimal:

@
42
@
-}
instance Externalize Int32 where
    formatExternal :: Int32 -> Rope
formatExternal = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Int32 -> ByteString) -> Int32 -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Int32 -> Builder) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
Builder.int32Dec
    parseExternal :: Rope -> Maybe Int32
parseExternal = String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int32) -> (Rope -> String) -> Rope -> Maybe Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

{- |
Integers are represented in decimal:

@
42
@
-}
instance Externalize Int64 where
    formatExternal :: Int64 -> Rope
formatExternal = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Int64 -> ByteString) -> Int64 -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Int64 -> Builder) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
Builder.int64Dec
    parseExternal :: Rope -> Maybe Int64
parseExternal = String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int64) -> (Rope -> String) -> Rope -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

{- |
IEEE 754 floating point:

@
3.1415927
@
-}
instance Externalize Float where
    formatExternal :: Float -> Rope
formatExternal = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Float -> ByteString) -> Float -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Float -> Builder) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
Builder.floatDec
    parseExternal :: Rope -> Maybe Float
parseExternal = String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Float) -> (Rope -> String) -> Rope -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

{- |
IEEE 754 floating point:

@
3.141592653589793
@
-}
instance Externalize Double where
    formatExternal :: Double -> Rope
formatExternal = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Double -> ByteString) -> Double -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Double -> Builder) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
Builder.doubleDec
    parseExternal :: Rope -> Maybe Double
parseExternal = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double)
-> (Rope -> String) -> Rope -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

--
-- More than anything, THIS was the example that motivated creating this
-- module.
--

{- |
Unique identifiers are formatted as per RFC 4122:

@
6937e157-d041-4919-8690-4d6c12b7e0e3
@
-}
instance Externalize Uuid.UUID where
    formatExternal :: UUID -> Rope
formatExternal = Text -> Rope
forall α. Textual α => α -> Rope
intoRope (Text -> Rope) -> (UUID -> Text) -> UUID -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
Uuid.toText
    parseExternal :: Rope -> Maybe UUID
parseExternal = Text -> Maybe UUID
Uuid.fromText (Text -> Maybe UUID) -> (Rope -> Text) -> Rope -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Text
forall α. Textual α => Rope -> α
fromRope

--
-- This is a placeholder to remind that if we ever improve the machinery in
-- Core.Data.Clock to not use **hourglass** (which uses String) we could quite
-- likely get a better implementation here.
--

{- |
Timestamps are formatted as per ISO 8601:

@
2022-06-20T14:51:23.544826062Z
@
-}
instance Externalize Time where
    formatExternal :: Time -> Rope
formatExternal = String -> Rope
forall α. Textual α => α -> Rope
intoRope (String -> Rope) -> (Time -> String) -> Time -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> String
forall a. Show a => a -> String
show
    parseExternal :: Rope -> Maybe Time
parseExternal = String -> Maybe Time
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Time) -> (Rope -> String) -> Rope -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope

{- |
Numbers are converted to scientific notation:

@
2.99792458e8
@
-}
instance Externalize Scientific where
    formatExternal :: Scientific -> Rope
formatExternal = String -> Rope
forall α. Textual α => α -> Rope
intoRope (String -> Rope) -> (Scientific -> String) -> Scientific -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Exponent Maybe Int
forall a. Maybe a
Nothing
    parseExternal :: Rope -> Maybe Scientific
parseExternal = String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Scientific)
-> (Rope -> String) -> Rope -> Maybe Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope