-- 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>.

-- | String representation of
--
-- * LDAPv3 search 'Filter's as defined by <https://tools.ietf.org/html/rfc4515 RFC4515>
-- * LDAPv3 'DistinguishedName's as defined by <https://tools.ietf.org/html/rfc4514 RFC4514>
--
-- @since 0.1.0
module LDAPv3.StringRepr
    ( StringRepr ( asParsec
             , asBuilder
             , renderShortText
             )
    , renderText
    , renderString
    , parseShortText
    , parseText
    , parseString

    -- * Distinguished Names

    , DistinguishedName(DistinguishedName)
    , rfc4514coreAttributes
    ) where

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

import qualified Data.Text.Short             as TS
import           Text.Parsec                 as P

import           LDAPv3.AttributeDescription ()
import           LDAPv3.DistinguishedName    (DistinguishedName (..), rfc4514coreAttributes)
import           LDAPv3.SearchFilter         ()
import           LDAPv3.StringRepr.Class

-- | Convenience 'StringRepr' operation for rendering as 'Text'
--
-- @since 0.1.0
renderText :: StringRepr a => a -> Text
renderText :: a -> Text
renderText = 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

-- | Convenience 'StringRepr' operation for rendering as plain-old 'String'
--
-- @since 0.1.0
renderString :: StringRepr a => a -> String
renderString :: a -> String
renderString = ShortText -> String
TS.toString (ShortText -> String) -> (a -> ShortText) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShortText
forall a. StringRepr a => a -> ShortText
renderShortText

-- | Convenience 'StringRepr' operation for parsing from 'Text'
--
-- @since 0.1.0
parseText :: StringRepr a => Text -> Maybe a
parseText :: Text -> Maybe a
parseText = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either ParseError a -> Maybe a)
-> (Text -> Either ParseError a) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () a -> String -> Text -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec Text () a
forall a s. (StringRepr a, Stream s Identity Char) => Parsec s () a
asParsec Parsec Text () a -> ParsecT Text () Identity () -> Parsec Text () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) ""

-- | Convenience 'StringRepr' operation for parsing from 'ShortText'
--
-- @since 0.1.0
parseShortText :: StringRepr a => ShortText -> Maybe a
parseShortText :: ShortText -> Maybe a
parseShortText = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either ParseError a -> Maybe a)
-> (ShortText -> Either ParseError a) -> ShortText -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec String () a
forall a s. (StringRepr a, Stream s Identity Char) => Parsec s () a
asParsec Parsec String () a
-> ParsecT String () Identity () -> Parsec String () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) "" (String -> Either ParseError a)
-> (ShortText -> String) -> ShortText -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
TS.toString

-- | Convenience 'StringRepr' operation for parsing from plain-old 'String'
--
-- @since 0.1.0
parseString :: StringRepr a => String -> Maybe a
parseString :: String -> Maybe a
parseString = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either ParseError a -> Maybe a)
-> (String -> Either ParseError a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec String () a
forall a s. (StringRepr a, Stream s Identity Char) => Parsec s () a
asParsec Parsec String () a
-> ParsecT String () Identity () -> Parsec String () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) ""