{-# LANGUAGE RankNTypes    #-}
{-# LANGUAGE Safe          #-}
{-# LANGUAGE TypeOperators #-}

{- |

Write your grammar once and get both parser and pretty-printer, for
free.

> import GHC.Generics
> import Data.Text (Text)
> import Language.SexpGrammar
> import Language.SexpGrammar.Generic
>
> data Person = Person
>   { pName    :: Text
>   , pAddress :: Text
>   , pAge     :: Maybe Int
>   } deriving (Show, Generic)
>
> instance SexpIso Person where
>   sexpIso = with $ \person ->  -- Person is isomorphic to:
>     list (                           -- a list with
>       el (sym "person") >>>          -- a symbol "person",
>       el string         >>>          -- a string, and
>       props (                        -- a property-list with
>         "address" .:  string >>>     -- a keyword :address and a string value, and
>         "age"     .:? int))  >>>     -- an optional keyword :age with int value.
>     person

So now we can use this isomorphism to parse S-expessions to @Person@
record and pretty-print @Person@ records back to S-expression.

> (person "John Doe" :address "42 Whatever str." :age 25)

will parse into:

> Person {pName = "John Doe", pAddress = "42 Whatever str.", pAge = Just 25}

and the record will pretty-print back into:

> (person "John Doe" :address "42 Whatever str." :age 25)

-}

module Language.SexpGrammar
  ( -- * Data types
    Sexp
  , Position
  , SexpGrammar
  , Grammar
  , (:-)
  , SexpIso (..)
  -- * Encoding
  , toSexp
  , encode
  , encodeWith
  , encodePretty
  , encodePrettyWith
  -- * Decoding
  , fromSexp
  , decode
  , decodeWith
  -- * Combinators
  , module Control.Category
  , module Data.InvertibleGrammar.Combinators
  , module Language.SexpGrammar.Base
  -- * Error reporting
  , Mismatch
  , expected
  , unexpected
  ) where

import Control.Category ((<<<), (>>>))

import Data.ByteString.Lazy.Char8 (ByteString)
import Data.InvertibleGrammar
import Data.InvertibleGrammar.Combinators

import Language.Sexp.Located (Sexp, Position)
import qualified Language.Sexp.Located as Sexp

import Language.SexpGrammar.Base
import Language.SexpGrammar.Class

----------------------------------------------------------------------
-- Sexp interface

-- | Run grammar in parsing (left-to-right) direction
--
-- > fromSexp g = runGrammarString Sexp.dummyPos . forward (sealed g)
fromSexp :: SexpGrammar a -> Sexp -> Either String a
fromSexp :: SexpGrammar a -> Sexp -> Either String a
fromSexp SexpGrammar a
g =
  Position
-> ContextError (Propagation Position) (GrammarError Position) a
-> Either String a
forall p a.
Show p =>
p
-> ContextError (Propagation p) (GrammarError p) a
-> Either String a
runGrammarString Position
Sexp.dummyPos (ContextError (Propagation Position) (GrammarError Position) a
 -> Either String a)
-> (Sexp
    -> ContextError (Propagation Position) (GrammarError Position) a)
-> Sexp
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Grammar Position Sexp a
-> Sexp
-> ContextError (Propagation Position) (GrammarError Position) a
forall p a b.
Grammar p a b
-> a -> ContextError (Propagation p) (GrammarError p) b
forward (Grammar Position (Sexp :- Void) (a :- Void)
-> Grammar Position Sexp a
forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed Grammar Position (Sexp :- Void) (a :- Void)
SexpGrammar a
g)

-- | Run grammar in generating (right-to-left) direction
--
-- > toSexp g = runGrammarString Sexp.dummyPos . backward (sealed g)
toSexp :: SexpGrammar a -> a -> Either String Sexp
toSexp :: SexpGrammar a -> a -> Either String Sexp
toSexp SexpGrammar a
g =
  Position
-> ContextError (Propagation Position) (GrammarError Position) Sexp
-> Either String Sexp
forall p a.
Show p =>
p
-> ContextError (Propagation p) (GrammarError p) a
-> Either String a
runGrammarString Position
Sexp.dummyPos (ContextError (Propagation Position) (GrammarError Position) Sexp
 -> Either String Sexp)
-> (a
    -> ContextError
         (Propagation Position) (GrammarError Position) Sexp)
-> a
-> Either String Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Grammar Position Sexp a
-> a
-> ContextError (Propagation Position) (GrammarError Position) Sexp
forall p a b.
Grammar p a b
-> b -> ContextError (Propagation p) (GrammarError p) a
backward (Grammar Position (Sexp :- Void) (a :- Void)
-> Grammar Position Sexp a
forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed Grammar Position (Sexp :- Void) (a :- Void)
SexpGrammar a
g)

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

-- | Serialize a value using 'SexpIso' instance
encode :: SexpIso a => a -> Either String ByteString
encode :: a -> Either String ByteString
encode =
  SexpGrammar a -> a -> Either String ByteString
forall a. SexpGrammar a -> a -> Either String ByteString
encodeWith SexpGrammar a
forall a. SexpIso a => SexpGrammar a
sexpIso

-- | Serialise a value using a provided grammar
encodeWith :: SexpGrammar a -> a -> Either String ByteString
encodeWith :: SexpGrammar a -> a -> Either String ByteString
encodeWith SexpGrammar a
g =
  (Sexp -> ByteString)
-> Either String Sexp -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sexp -> ByteString
Sexp.encode (Either String Sexp -> Either String ByteString)
-> (a -> Either String Sexp) -> a -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SexpGrammar a -> a -> Either String Sexp
forall a. SexpGrammar a -> a -> Either String Sexp
toSexp SexpGrammar a
g

-- | Serialise and pretty-print a value using its 'SexpIso' instance
encodePretty :: SexpIso a => a -> Either String ByteString
encodePretty :: a -> Either String ByteString
encodePretty =
  SexpGrammar a -> a -> Either String ByteString
forall a. SexpGrammar a -> a -> Either String ByteString
encodePrettyWith SexpGrammar a
forall a. SexpIso a => SexpGrammar a
sexpIso

-- | Serialise and pretty-print a value using a provided grammar
encodePrettyWith :: SexpGrammar a -> a -> Either String ByteString
encodePrettyWith :: SexpGrammar a -> a -> Either String ByteString
encodePrettyWith SexpGrammar a
g =
  (Sexp -> ByteString)
-> Either String Sexp -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sexp -> ByteString
Sexp.format (Either String Sexp -> Either String ByteString)
-> (a -> Either String Sexp) -> a -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SexpGrammar a -> a -> Either String Sexp
forall a. SexpGrammar a -> a -> Either String Sexp
toSexp SexpGrammar a
g

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

-- | Deserialise a value using its 'SexpIso' instance
decode :: SexpIso a => ByteString -> Either String a
decode :: ByteString -> Either String a
decode =
  SexpGrammar a -> String -> ByteString -> Either String a
forall a. SexpGrammar a -> String -> ByteString -> Either String a
decodeWith SexpGrammar a
forall a. SexpIso a => SexpGrammar a
sexpIso String
"<string>"

-- | Deserialise a value using provided grammar, use a provided file
-- name for error messages
decodeWith :: SexpGrammar a -> FilePath -> ByteString -> Either String a
decodeWith :: SexpGrammar a -> String -> ByteString -> Either String a
decodeWith SexpGrammar a
g String
fn ByteString
input =
  String -> ByteString -> Either String Sexp
Sexp.parseSexp String
fn ByteString
input Either String Sexp -> (Sexp -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SexpGrammar a -> Sexp -> Either String a
forall a. SexpGrammar a -> Sexp -> Either String a
fromSexp SexpGrammar a
g