------------------------------------------------------------------------------
-- |
-- Module      : Data.TTC.Instances
-- Description : instances for basic data types
-- Copyright   : Copyright (c) 2019-2021 Travis Cardwell
-- License     : MIT
--
-- This module defines TTC 'TTC.Render' and 'TTC.Parse' instances for some
-- basic data types.  The definitions for the numeric data types are
-- implemented using the 'Show' and 'Read' instances.  The definitions for the
-- character and textual data types are implemented without quoting.
--
-- To use these instances, explicitly import them as follows:
--
-- @
-- import Data.TTC.Instances ()
-- @
------------------------------------------------------------------------------

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.TTC.Instances () where

-- https://hackage.haskell.org/package/base
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8)

-- https://hackage.haskell.org/package/bytestring
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL

-- https://hackage.haskell.org/package/text
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

-- (ttc)
import qualified Data.TTC as TTC

------------------------------------------------------------------------------

instance TTC.Parse Char where
  parse :: t -> Either e Char
parse = (String -> Either e Char) -> t -> Either e Char
forall t a. Textual t => (String -> a) -> t -> a
TTC.asS ((String -> Either e Char) -> t -> Either e Char)
-> (String -> Either e Char) -> t -> Either e Char
forall a b. (a -> b) -> a -> b
$ \case
    [Char
c] -> Char -> Either e Char
forall a b. b -> Either a b
Right Char
c
    String
_cs -> e -> Either e Char
forall a b. a -> Either a b
Left (e -> Either e Char) -> e -> Either e Char
forall a b. (a -> b) -> a -> b
$ String -> e
forall t. Textual t => String -> t
TTC.fromS String
"invalid Char"

instance TTC.Render Char where
  render :: Char -> t
render Char
c = String -> t
forall t. Textual t => String -> t
TTC.fromS [Char
c]

------------------------------------------------------------------------------

instance TTC.Parse Double where
  parse :: t -> Either e Double
parse = String -> t -> Either e Double
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Double"

instance TTC.Render Double where
  render :: Double -> t
render = Double -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Float where
  parse :: t -> Either e Float
parse = String -> t -> Either e Float
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Float"

instance TTC.Render Float where
  render :: Float -> t
render = Float -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Int where
  parse :: t -> Either e Int
parse = String -> t -> Either e Int
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Int"

instance TTC.Render Int where
  render :: Int -> t
render = Int -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Int8 where
  parse :: t -> Either e Int8
parse = String -> t -> Either e Int8
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Int8"

instance TTC.Render Int8 where
  render :: Int8 -> t
render = Int8 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Int16 where
  parse :: t -> Either e Int16
parse = String -> t -> Either e Int16
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Int16"

instance TTC.Render Int16 where
  render :: Int16 -> t
render = Int16 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Int32 where
  parse :: t -> Either e Int32
parse = String -> t -> Either e Int32
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Int32"

instance TTC.Render Int32 where
  render :: Int32 -> t
render = Int32 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Int64 where
  parse :: t -> Either e Int64
parse = String -> t -> Either e Int64
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Int64"

instance TTC.Render Int64 where
  render :: Int64 -> t
render = Int64 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Integer where
  parse :: t -> Either e Integer
parse = String -> t -> Either e Integer
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Integer"

instance TTC.Render Integer where
  render :: Integer -> t
render = Integer -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Word where
  parse :: t -> Either e Word
parse = String -> t -> Either e Word
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Word"

instance TTC.Render Word where
  render :: Word -> t
render = Word -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Word8 where
  parse :: t -> Either e Word8
parse = String -> t -> Either e Word8
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Word8"

instance TTC.Render Word8 where
  render :: Word8 -> t
render = Word8 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Word16 where
  parse :: t -> Either e Word16
parse = String -> t -> Either e Word16
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Word16"

instance TTC.Render Word16 where
  render :: Word16 -> t
render = Word16 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Word32 where
  parse :: t -> Either e Word32
parse = String -> t -> Either e Word32
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Word32"

instance TTC.Render Word32 where
  render :: Word32 -> t
render = Word32 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse Word64 where
  parse :: t -> Either e Word64
parse = String -> t -> Either e Word64
forall a t e.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
TTC.parseWithRead' String
"Word64"

instance TTC.Render Word64 where
  render :: Word64 -> t
render = Word64 -> t
forall a t. (Show a, Textual t) => a -> t
TTC.renderWithShow

------------------------------------------------------------------------------

instance TTC.Parse String where
  parse :: t -> Either e String
parse = String -> Either e String
forall a b. b -> Either a b
Right (String -> Either e String)
-> (t -> String) -> t -> Either e String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. Textual t => t -> String
TTC.toS

instance TTC.Render String where
  render :: String -> t
render = String -> t
forall t. Textual t => String -> t
TTC.fromS

------------------------------------------------------------------------------

instance TTC.Parse BSL.ByteString where
  parse :: t -> Either e ByteString
parse = ByteString -> Either e ByteString
forall a b. b -> Either a b
Right (ByteString -> Either e ByteString)
-> (t -> ByteString) -> t -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t. Textual t => t -> ByteString
TTC.toBSL

instance TTC.Render BSL.ByteString where
  render :: ByteString -> t
render = ByteString -> t
forall t. Textual t => ByteString -> t
TTC.fromBSL

------------------------------------------------------------------------------

instance TTC.Parse BS.ByteString where
  parse :: t -> Either e ByteString
parse = ByteString -> Either e ByteString
forall a b. b -> Either a b
Right (ByteString -> Either e ByteString)
-> (t -> ByteString) -> t -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t. Textual t => t -> ByteString
TTC.toBS

instance TTC.Render BS.ByteString where
  render :: ByteString -> t
render = ByteString -> t
forall t. Textual t => ByteString -> t
TTC.fromBS

------------------------------------------------------------------------------

instance TTC.Parse TL.Text where
  parse :: t -> Either e Text
parse = Text -> Either e Text
forall a b. b -> Either a b
Right (Text -> Either e Text) -> (t -> Text) -> t -> Either e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t. Textual t => t -> Text
TTC.toTL

instance TTC.Render TL.Text where
  render :: Text -> t
render = Text -> t
forall t. Textual t => Text -> t
TTC.fromTL

------------------------------------------------------------------------------

instance TTC.Parse T.Text where
  parse :: t -> Either e Text
parse = Text -> Either e Text
forall a b. b -> Either a b
Right (Text -> Either e Text) -> (t -> Text) -> t -> Either e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t. Textual t => t -> Text
TTC.toT

instance TTC.Render T.Text where
  render :: Text -> t
render = Text -> t
forall t. Textual t => Text -> t
TTC.fromT