{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances,
             GeneralizedNewtypeDeriving, MultiParamTypeClasses,
             OverlappingInstances, TypeFamilies, UndecidableInstances #-}

{- |
   Module      : Data.Buildable
   Description : Builders for linear data structures
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

Various linear data structures can be expensive to construct in a
repetitive fashion.  For example, to append a single value to the end
of a list is @O(n)@, and as such doing so repeatedly is recommended
against.

As such, to efficiently construct such structures we have the notion
of a /builder/.  This can be used to more efficiently prepend and
append values, and at the end we \"run\" the builder to construct the
overall value.

This module provides an abstraction over various builders for specific
data structures.  It also aims to minimise the number of functions
required to add various values to the builder by using a typeclass and
newtype wrappers.

To construct a value from it's builder:

    1. Start with either @'mempty'@ for an empty 'Builder', or if you
       have an initial value use @'fromValue'@.

    2. Add initial values to the front or back using 'prepend' \/ '<|'
       or 'append' \/ '|>' respectively.

    3. Once you've finished constructing your builder, create your
       final value with 'build'.

/Note/: all instances are defined for both strict and lazy
@ByteString@ and @Text@ values.

 -}
module Data.Buildable
  ( -- * Typeclasses
    Buildable (..)
  , BuildFrom (..)
  , CanBuildFrom
  , singleton
  , (<|)
  , (|>)
    -- * Chunked builder
    -- $chunked
  , Chunked (..)
  , ChunkedBuilder (..)

    -- * ByteString Builders
    -- $bytestring

    -- ** Numeric wrappers
    -- $numeric
  , BigEndian (..)
  , LittleEndian (..)
  , Dec (..)
  , Hex (..)
  , HexFixed (..)
    -- ** Textual wrappers
    -- $textual
  , Char7 (..)
  , Char8 (..)
  , Utf8 (..)
  , Utf16 (..)
  , Utf32 (..)

    -- * Text Builders
    -- $text
  ) where

import Data.Monoid (Monoid (..), (<>))
import Data.String (IsString (..))

import qualified Data.DList as DL

import qualified Data.ByteString                    as SB
import qualified Data.ByteString.Lazy               as LB
import qualified Data.ByteString.Lazy.Builder       as B
import qualified Data.ByteString.Lazy.Builder.ASCII as B
import           Data.Int
import           Data.Word

import qualified Data.Text               as ST
import qualified Data.Text.Encoding      as ST
import qualified Data.Text.Lazy          as LT
import qualified Data.Text.Lazy.Builder  as T
import qualified Data.Text.Lazy.Encoding as LT

import qualified Data.Sequence as S

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

-- | A linear data structure @a@ is buildable if we can prepend and
--   append both values of the data structure in question and its
--   constituent elements to the builder.
class (BuildFrom (Builder a) a, BuildFrom (Builder a) (Unit a))
      => Buildable a where

  -- | The individual elements.
  type Unit a

  type Builder a

  -- | Build the actual data structure.
  build :: Builder a -> a

-- | @CanBuildFrom b a@ states that we can build a value of type @b@
--   with values of type @a@.
type CanBuildFrom b a = (Buildable b, BuildFrom (Builder b) a)

singleton :: (CanBuildFrom b a) => a -> b
singleton = build . fromValue
{-# INLINE [1] singleton #-}
-- The [1] is to make sure the rule fires.

{-# RULES

"singleton/sametype" forall b. singleton b = b

 #-}

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

-- | Which values can be built from other values?
--
--   Minimal complete definition:
--
--     * @fromValue@
class (Monoid b) => BuildFrom b a where

  -- | Create a builder from an initial value.
  fromValue :: a -> b

  -- | Add a value to the front.
  prepend :: a -> b -> b
  prepend a b = fromValue a <> b

  -- | Add a value to the end.
  append :: b -> a -> b
  append b a = b <> fromValue a

-- | An alias for 'prepend'.
--
--   Mnemonic: the arrow points to the new value.
(<|) :: (BuildFrom b a) => a -> b -> b
(<|) = prepend

infixr 4 <|

-- | An alias for 'append'.
--
--   Mnemonic: the arrow points to the new value.
(|>) :: (BuildFrom b a) => b -> a -> b
(|>) = append

infixl 5 |>
-- Have this bind tighter than <| because if builders have a
-- preference, it's that appends should be preferred (thus take care
-- of any appends first before prepending as it might prove cheaper).

-- -----------------------------------------------------------------------------
-- Lists

instance Buildable [a] where
  type Unit [a] = a
  type Builder [a] = DL.DList a

  build = DL.toList

instance BuildFrom [a] a where
  fromValue = (: [])

  prepend = (:)

instance BuildFrom (DL.DList a) [a] where
  fromValue = DL.fromList

instance BuildFrom (DL.DList a) a where
  fromValue = DL.singleton

  prepend = DL.cons

  append = DL.snoc

instance BuildFrom (DL.DList [a]) a where
  fromValue = DL.singleton . (: [])

  prepend = DL.cons . (: [])

  append b = DL.snoc b . (: [])

-- -----------------------------------------------------------------------------
-- Chunked builder

{- $chunked

For either testing purposes or some other reason, rather than actually
creating an overall value you may actually want a list of a
'Buildable' type.

The 'Chunked' type allows you to efficiently create a list of such
values by converting every provided value into the specified type.

-}

-- | An explicit chunkified representation of a Builder.  If we have a
-- polymorphic expression @buildValue@ that can be used to build
-- something of type @b@, then the following are equivalent:
--
--   > 'build' buildValue == mconcat . unChunk $ build buildValue
newtype Chunked a = Chunks { unChunk :: [a]}
  deriving (Eq, Ord, Show, Read, Monoid, Functor)

-- | You probably won't actually need to use this type; it's defined
--   solely to be the 'Builder' for 'Chunked'.
newtype ChunkedBuilder a = CB { unCB :: DL.DList a }
  deriving (Monoid, Functor)

instance (Buildable b) => Buildable (Chunked b) where
  type Unit (Chunked b) = b
  type Builder (Chunked b) = ChunkedBuilder b

  build = Chunks . DL.toList . unCB

instance (Buildable b) => BuildFrom (ChunkedBuilder b) (Chunked b) where
  fromValue = CB . DL.fromList . unChunk

instance (CanBuildFrom b a) => BuildFrom (ChunkedBuilder b) a where
  fromValue = CB . DL.singleton . singleton

  prepend a (CB b) = CB (singleton a `DL.cons` b)

  append (CB b) a = CB (b `DL.snoc` singleton a)

-- -----------------------------------------------------------------------------
-- ByteStrings

{- $bytestring

There are various ways that numeric and textual types can be built
into part of a @ByteString@ (be it strict or lazy).  To be able to
choose between these, various wrapper types have been defined.

What you can add to the @ByteString@ Builder:

    * Strict and lazy ByteStrings.

    * Numeric types, though most require a wrapper to disambiguate
      /how/ to add it (see below)/

    * 'Char' and 'String' and both strict and lazy @Text@ values after
      choosing an appropriate encoding (see below for wrapper types).

-}

-- | Strict ByteStrings.  This instance goes via lazy ByteStrings, and
--   as such they should be preferred.
instance Buildable SB.ByteString where
  type Unit SB.ByteString = Word8
  type Builder SB.ByteString = B.Builder

  build = LB.toStrict . B.toLazyByteString

{-# RULES "unbuild/SB.ByteString" forall b. LB.toStrict (B.toLazyByteString (B.byteString b)) = b #-}

-- | Lazy ByteStrings.  This instance should be preferred over the one
--   for strict ByteStrings.
instance Buildable LB.ByteString where
  type Unit LB.ByteString = Word8
  type Builder LB.ByteString = B.Builder

  build = B.toLazyByteString

{-# RULES "unbuild/LB.ByteString" forall b. B.toLazyByteString (B.lazyByteString b) = b #-}

{- $numeric

Apart from 'Word8' and 'Int8', all numeric types need to be specified
whether they should be encoded using 'BigEndian' or 'LittleEndian'
format (with the exception of decimal representation using 'Dec').

All wrappers derive the various numeric type classes so that you can
still perform various calculations on them.

-}

-- | Explicitly state that a number should be encoded in big-endian
--   format.
newtype BigEndian a = BE { unBE :: a }
  deriving ( Eq, Ord, Show, Read, Bounded, Enum
           , Num, Integral, Real, RealFloat, RealFrac, Floating, Fractional)

-- | Explicitly state that a number should be encoded in little-endian
--   format.
newtype LittleEndian a = LE { unLE :: a }
  deriving ( Eq, Ord, Show, Read, Bounded, Enum
           , Num, Integral, Real, RealFloat, RealFrac, Floating, Fractional)

-- | Encode a number as its decimal representation with ASCII-encoded
--   characters.
newtype Dec a = Dec { unDec :: a }
  deriving ( Eq, Ord, Show, Read, Bounded, Enum
           , Num, Integral, Real, RealFloat, RealFrac, Floating, Fractional)

-- | Encode a number as its hexadecimal representation with
--   ASCII-encoded (lower-case) characters using the shortest possible
--   representation.  For fixed-width encoding use 'HexFixed' instead.
newtype Hex a = Hex { unHex :: a }
  deriving ( Eq, Ord, Show, Read, Bounded, Enum
           , Num, Integral, Real, RealFloat, RealFrac, Floating, Fractional)

-- | Encode a number as its hexadecimal representation with
--   ASCII-encoded (lower-case) characters using a fixed number of
--   hexadecimal digits.  For shortest-width encoding use 'Hex'
--   instead.
newtype HexFixed a = HexFixed { unHexFixed :: a }
  deriving ( Eq, Ord, Show, Read, Bounded, Enum
           , Num, Integral, Real, RealFloat, RealFrac, Floating, Fractional)

instance BuildFrom B.Builder SB.ByteString where
  fromValue = B.byteString

instance BuildFrom B.Builder (HexFixed SB.ByteString) where
  fromValue = B.byteStringHexFixed . unHexFixed

instance BuildFrom B.Builder LB.ByteString where
  fromValue = B.lazyByteString

instance BuildFrom B.Builder (HexFixed LB.ByteString) where
  fromValue = B.lazyByteStringHexFixed . unHexFixed

instance BuildFrom B.Builder Word8 where
  fromValue = B.word8

instance BuildFrom B.Builder (Dec Word8) where
  fromValue = B.word8Dec . unDec

instance BuildFrom B.Builder (Hex Word8) where
  fromValue = B.word8Hex . unHex

-- | Uses 2 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Word8) where
  fromValue = B.word8HexFixed . unHexFixed

instance BuildFrom B.Builder Int8 where
  fromValue = B.int8

instance BuildFrom B.Builder (Dec Int8) where
  fromValue = B.int8Dec . unDec

-- | Uses 2 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Int8) where
  fromValue = B.int8HexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Double) where
  fromValue = B.doubleBE . unBE

instance BuildFrom B.Builder (LittleEndian Double) where
  fromValue = B.doubleLE . unLE

-- | Currently slow.
instance BuildFrom B.Builder (Dec Double) where
  fromValue = B.doubleDec . unDec

-- | Uses 16 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Double) where
  fromValue = B.doubleHexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Float) where
  fromValue = B.floatBE . unBE

instance BuildFrom B.Builder (LittleEndian Float) where
  fromValue = B.floatLE . unLE

-- | Currently slow.
instance BuildFrom B.Builder (Dec Float) where
  fromValue = B.floatDec . unDec

-- | Uses 8 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Float) where
  fromValue = B.floatHexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Int16) where
  fromValue = B.int16BE . unBE

instance BuildFrom B.Builder (LittleEndian Int16) where
  fromValue = B.int16LE . unLE

instance BuildFrom B.Builder (Dec Int16) where
  fromValue = B.int16Dec . unDec

-- | Uses 4 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Int16) where
  fromValue = B.int16HexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Int32) where
  fromValue = B.int32BE . unBE

instance BuildFrom B.Builder (LittleEndian Int32) where
  fromValue = B.int32LE . unLE

instance BuildFrom B.Builder (Dec Int32) where
  fromValue = B.int32Dec . unDec

-- | Uses 8 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Int32) where
  fromValue = B.int32HexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Int64) where
  fromValue = B.int64BE . unBE

instance BuildFrom B.Builder (LittleEndian Int64) where
  fromValue = B.int64LE . unLE

instance BuildFrom B.Builder (Dec Int64) where
  fromValue = B.int64Dec . unDec

-- | Uses 16 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Int64) where
  fromValue = B.int64HexFixed . unHexFixed

instance BuildFrom B.Builder (Dec Int) where
  fromValue = B.intDec . unDec

instance BuildFrom B.Builder (Dec Integer) where
  fromValue = B.integerDec . unDec

instance BuildFrom B.Builder (BigEndian Word16) where
  fromValue = B.word16BE . unBE

instance BuildFrom B.Builder (LittleEndian Word16) where
  fromValue = B.word16LE . unLE

instance BuildFrom B.Builder (Dec Word16) where
  fromValue = B.word16Dec . unDec

instance BuildFrom B.Builder (Hex Word16) where
  fromValue = B.word16Hex . unHex

-- | Uses 4 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Word16) where
  fromValue = B.word16HexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Word32) where
  fromValue = B.word32BE . unBE

instance BuildFrom B.Builder (LittleEndian Word32) where
  fromValue = B.word32LE . unLE

instance BuildFrom B.Builder (Dec Word32) where
  fromValue = B.word32Dec . unDec

instance BuildFrom B.Builder (Hex Word32) where
  fromValue = B.word32Hex . unHex

-- | Uses 8 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Word32) where
  fromValue = B.word32HexFixed . unHexFixed

instance BuildFrom B.Builder (BigEndian Word64) where
  fromValue = B.word64BE . unBE

instance BuildFrom B.Builder (LittleEndian Word64) where
  fromValue = B.word64LE . unLE

instance BuildFrom B.Builder (Dec Word64) where
  fromValue = B.word64Dec . unDec

instance BuildFrom B.Builder (Hex Word64) where
  fromValue = B.word64Hex . unHex

-- | Uses 16 nibbles/hexadecimal digits.
instance BuildFrom B.Builder (HexFixed Word64) where
  fromValue = B.word64HexFixed . unHexFixed

instance BuildFrom B.Builder (Dec Word) where
  fromValue = B.wordDec . unDec

instance BuildFrom B.Builder (Hex Word) where
  fromValue = B.wordHex . unHex

{- $textual

There are various different encodings that can be used to encode
textual data as a series of binary digits.  As such, it is necessary
to specify which encoding you want to use.

For 'Utf16' and 'Utf32' it is also necessary to specify whether you
want to use a 'BigEndian' or 'LittleEndian' format; the order of
newtype wrappers doesn't matter.

These are also used to encode a @ByteString@ into the 'Builder' for
@Text@ values (both strict and lazy).

-}

-- | Unicode codepoints are truncated to 7 bits and prefixed with a
--   leading 0.  For the codepoints 0-127 this corresponds to the
--   ASCII encoding.
newtype Char7 a = Char7 { unChar7 :: a }
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

instance (IsString a) => IsString (Char7 a) where
  fromString = Char7 . fromString

-- | Unicode codepoints are truncated to 8 bits.  For the codepoints
--   0-255 this corresponds to the ISO/IEC 8859-1 (aka Latin-1)
--   encoding.
newtype Char8 a = Char8 { unChar8 :: a }
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

instance (IsString a) => IsString (Char8 a) where
  fromString = Char8 . fromString

-- | Encode a textual value using UTF-8.
newtype Utf8 a = Utf8 { unUtf8 :: a }
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

instance (IsString a) => IsString (Utf8 a) where
  fromString = Utf8 . fromString

-- | Encode a textual value using UTF-16.
--
--   Needs to be used with either 'BigEndian' or 'LittleEndian'.
newtype Utf16 a = Utf16 { unUtf16 :: a }
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

instance (IsString a) => IsString (Utf16 a) where
  fromString = Utf16 . fromString

-- | Encode a textual value using UTF-32.
--
--   Needs to be used with either 'BigEndian' or 'LittleEndian'.
newtype Utf32 a = Utf32 { unUtf32 :: a }
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

instance (IsString a) => IsString (Utf32 a) where
  fromString = Utf32 . fromString

instance BuildFrom B.Builder (Char7 Char) where
  fromValue = B.char7 . unChar7

instance BuildFrom B.Builder (Char8 Char) where
  fromValue = B.char8 . unChar8

instance BuildFrom B.Builder (Utf8 Char) where
  fromValue = B.charUtf8 . unUtf8

instance BuildFrom B.Builder (Char7 String) where
  fromValue = B.string7 . unChar7

instance BuildFrom B.Builder (Char8 String) where
  fromValue = B.string8 . unChar8

instance BuildFrom B.Builder (Utf8 String) where
  fromValue = B.stringUtf8 . unUtf8

-- | For strict Text values; goes via a strict ByteString.
instance BuildFrom B.Builder (Utf8 ST.Text) where
  fromValue = B.byteString . ST.encodeUtf8 . unUtf8

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @Utf16 (BigEndian Text)@ instance.
instance BuildFrom B.Builder (BigEndian (Utf16 ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf16BE . unUtf16 . unBE

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @BigEndian (Utf16 Text)@ instance.
instance BuildFrom B.Builder (Utf16 (BigEndian ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf16BE . unBE . unUtf16

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @Utf16 (LittleEndian Text)@ instance.
instance BuildFrom B.Builder (LittleEndian (Utf16 ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf16LE . unUtf16 . unLE

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @LittleEndian (Utf16 Text)@ instance.
instance BuildFrom B.Builder (Utf16 (LittleEndian ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf16LE . unLE . unUtf16

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @Utf32 (BigEndian Text)@ instance.
instance BuildFrom B.Builder (BigEndian (Utf32 ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf32BE . unUtf32 . unBE

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @BigEndian (Utf32 Text)@ instance.
instance BuildFrom B.Builder (Utf32 (BigEndian ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf32BE . unBE . unUtf32

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @Utf32 (LittleEndian Text)@ instance.
instance BuildFrom B.Builder (LittleEndian (Utf32 ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf32LE . unUtf32 . unLE

-- | For strict Text values; goes via a strict ByteString.  Equivalent
--   to the @LittleEndian (Utf32 Text)@ instance.
instance BuildFrom B.Builder (Utf32 (LittleEndian ST.Text)) where
  fromValue = B.byteString . ST.encodeUtf32LE . unLE . unUtf32

-- | For lazy Text values; goes via a lazy ByteString.
instance BuildFrom B.Builder (Utf8 LT.Text) where
  fromValue = B.lazyByteString . LT.encodeUtf8 . unUtf8

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @Utf16 (BigEndian Text)@ instance.
instance BuildFrom B.Builder (BigEndian (Utf16 LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf16BE . unUtf16 . unBE

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @BigEndian (Utf16 Text)@ instance.
instance BuildFrom B.Builder (Utf16 (BigEndian LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf16BE . unBE . unUtf16

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @Utf16 (LittleEndian Text)@ instance.
instance BuildFrom B.Builder (LittleEndian (Utf16 LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf16LE . unUtf16 . unLE

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @LittleEndian (Utf16 Text)@ instance.
instance BuildFrom B.Builder (Utf16 (LittleEndian LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf16LE . unLE . unUtf16

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @Utf32 (BigEndian Text)@ instance.
instance BuildFrom B.Builder (BigEndian (Utf32 LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf32BE . unUtf32 . unBE

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @BigEndian (Utf32 Text)@ instance.
instance BuildFrom B.Builder (Utf32 (BigEndian LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf32BE . unBE . unUtf32

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @Utf32 (LittleEndian Text)@ instance.
instance BuildFrom B.Builder (LittleEndian (Utf32 LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf32LE . unUtf32 . unLE

-- | For lazy Text values; goes via a lazy ByteString.  Equivalent
--   to the @LittleEndian (Utf32 Text)@ instance.
instance BuildFrom B.Builder (Utf32 (LittleEndian LT.Text)) where
  fromValue = B.lazyByteString . LT.encodeUtf32LE . unLE . unUtf32

-- -----------------------------------------------------------------------------
-- Text

{- $text

Both strict and lazy @Text@ values can be constructed via the text
Builder, though the latter is preferred.

Values that they can be built from:

    * Strict and lazy @Text@ values.

    * 'Char' and 'String' values directly.

    * Strict and lazy 'ByteStrings' after choosing an appropriate
      encoding.

-}

instance Buildable ST.Text where
  type Unit ST.Text = Char
  type Builder ST.Text = T.Builder

  build = LT.toStrict . T.toLazyText

instance Buildable LT.Text where
  type Unit LT.Text = Char
  type Builder LT.Text = T.Builder

  build = T.toLazyText

instance BuildFrom T.Builder ST.Text where
  fromValue = T.fromText

instance BuildFrom T.Builder LT.Text where
  fromValue = T.fromLazyText

instance BuildFrom T.Builder Char where
  fromValue = T.singleton

instance BuildFrom T.Builder String where
  fromValue = T.fromString

-- | For strict ByteStrings; goes via a strict Text.
instance BuildFrom T.Builder (Char8 SB.ByteString) where
  fromValue = T.fromText . ST.decodeLatin1 . unChar8

-- | For strict ByteStrings; goes via a strict Text.
instance BuildFrom T.Builder (Utf8 SB.ByteString) where
  fromValue = T.fromText . ST.decodeUtf8 . unUtf8

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @Utf16 (BigEndian ByteString)@ instance.
instance BuildFrom T.Builder (BigEndian (Utf16 SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf16BE . unUtf16 . unBE

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @BigEndian (Utf16 ByteString)@ instance.
instance BuildFrom T.Builder (Utf16 (BigEndian SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf16BE . unBE . unUtf16

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @Utf16 (LittleEndian ByteString)@ instance.
instance BuildFrom T.Builder (LittleEndian (Utf16 SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf16LE . unUtf16 . unLE

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @LittleEndian (Utf16 ByteString)@ instance.
instance BuildFrom T.Builder (Utf16 (LittleEndian SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf16LE . unLE . unUtf16

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @Utf32 (BigEndian ByteString)@ instance.
instance BuildFrom T.Builder (BigEndian (Utf32 SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf32BE . unUtf32 . unBE

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @BigEndian (Utf32 ByteString)@ instance.
instance BuildFrom T.Builder (Utf32 (BigEndian SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf32BE . unBE . unUtf32

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @Utf32 (LittleEndian ByteString)@ instance.
instance BuildFrom T.Builder (LittleEndian (Utf32 SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf32LE . unUtf32 . unLE

-- | For strict ByteStrings; goes via a strict Text.  Equivalent to
--   the @LittleEndian (Utf32 ByteString)@ instance.
instance BuildFrom T.Builder (Utf32 (LittleEndian SB.ByteString)) where
  fromValue = T.fromText . ST.decodeUtf32LE . unLE . unUtf32

-- | For lazy ByteStrings; goes via a lazy Text.
instance BuildFrom T.Builder (Char8 LB.ByteString) where
  fromValue = T.fromLazyText . LT.decodeLatin1 . unChar8

-- | For lazy ByteStrings; goes via a lazy Text.
instance BuildFrom T.Builder (Utf8 LB.ByteString) where
  fromValue = T.fromLazyText . LT.decodeUtf8 . unUtf8

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @Utf16 (BigEndian ByteString)@ instance.
instance BuildFrom T.Builder (BigEndian (Utf16 LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf16BE . unUtf16 . unBE

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @BigEndian (Utf16 ByteString)@ instance.
instance BuildFrom T.Builder (Utf16 (BigEndian LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf16BE . unBE . unUtf16

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @Utf16 (LittleEndian ByteString)@ instance.
instance BuildFrom T.Builder (LittleEndian (Utf16 LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf16LE . unUtf16 . unLE

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @LittleEndian (Utf16 ByteString)@ instance.
instance BuildFrom T.Builder (Utf16 (LittleEndian LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf16LE . unLE . unUtf16

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @Utf32 (BigEndian ByteString)@ instance.
instance BuildFrom T.Builder (BigEndian (Utf32 LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf32BE . unUtf32 . unBE

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @BigEndian (Utf32 ByteString)@ instance.
instance BuildFrom T.Builder (Utf32 (BigEndian LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf32BE . unBE . unUtf32

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @Utf32 (LittleEndian ByteString)@ instance.
instance BuildFrom T.Builder (LittleEndian (Utf32 LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf32LE . unUtf32 . unLE

-- | For lazy ByteStrings; goes via a lazy Text.  Equivalent to
--   the @LittleEndian (Utf32 ByteString)@ instance.
instance BuildFrom T.Builder (Utf32 (LittleEndian LB.ByteString)) where
  fromValue = T.fromLazyText . LT.decodeUtf32LE . unLE . unUtf32

-- -----------------------------------------------------------------------------
-- Sequences

instance Buildable (S.Seq a) where
  type Unit (S.Seq a) = a
  type Builder (S.Seq a) = S.Seq a

  build = id

instance BuildFrom (S.Seq a) (S.Seq a) where
  fromValue = id

instance BuildFrom (S.Seq a) a where
  fromValue = S.singleton

  prepend = (S.<|)

  append = (S.|>)

instance BuildFrom (S.Seq a) [a] where
  fromValue = S.fromList