-- Copyright (c) 2019  Herbert Valerio Riedel <hvr@gnu.org>
--
--  This file is free software: you may copy, redistribute and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation, either version 2 of the License, or (at your
--  option) any later version.
--
--  This file is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program (see `LICENSE`).  If not, see
--  <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html>.

{-# LANGUAGE FlexibleContexts  #-}

module LDAPv3.StringRepr.Class where

import           Common                 hiding (Option, many, option, some, (<|>))

import qualified Data.Text.Lazy         as T (toStrict)
import           Data.Text.Lazy.Builder as B
import qualified Data.Text.Short        as TS
import           Text.Parsec            as P

-- | Convert to and from string representations as defined by <https://tools.ietf.org/html/rfc4515 RFC4515>.
--
-- @since 0.1.0
class StringRepr a where
  asParsec :: Stream s Identity Char => Parsec s () a

  asBuilder :: a -> Builder
  asBuilder = Text -> Builder
fromText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
TS.toText (ShortText -> Text) -> (a -> ShortText) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShortText
forall a. StringRepr a => a -> ShortText
renderShortText

  renderShortText :: a -> ShortText
  renderShortText = Text -> ShortText
TS.fromText (Text -> ShortText) -> (a -> Text) -> a -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
B.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. StringRepr a => a -> Builder
asBuilder

  {-# MINIMAL asParsec, (renderShortText | asBuilder) #-}