{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE Trustworthy       #-}
{-# LANGUAGE TypeOperators     #-}

module Language.SexpGrammar.Base
  ( position
  -- * Atoms
  , real
  , double
  , int
  , integer
  , string
  , symbol
  , keyword
  , sym
  , kwd
  -- * Lists
  , List
  , list
  , bracketList
  , braceList
  , el
  , rest
  -- * Property lists
  , PropertyList
  , props
  , key
  , optKey
  , (.:)
  , (.:?)
  , restKeys
    -- * Quotes, antiquotes, etc
  , Prefix (..)
  , prefixed
  , quoted
  , hashed
  ) where

import Control.Category ((>>>))

import Data.Coerce
import Data.InvertibleGrammar
import Data.InvertibleGrammar.Base
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif

import Language.Sexp.Located

-- Setup code for doctest.
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Language.SexpGrammar (encodeWith)

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

ppBrief :: Sexp -> Text
ppBrief :: Sexp -> Text
ppBrief = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  atom :: Sexp
atom@Atom{} ->
    ByteString -> Text
TL.decodeUtf8 (Sexp -> ByteString
encode Sexp
atom)
  Sexp
other ->
    let pp :: Text
pp = ByteString -> Text
TL.decodeUtf8 (Sexp -> ByteString
encode Sexp
other)
    in if Text -> Int64
TL.length Text
pp forall a. Ord a => a -> a -> Bool
> Int64
25
       then Int64 -> Text -> Text
TL.take Int64
25 Text
pp forall a. Semigroup a => a -> a -> a
<> Text
"..."
       else Text
pp

ppKey :: Text -> Text
ppKey :: Text -> Text
ppKey Text
kw = Text
"keyword :" forall a. Semigroup a => a -> a -> a
<> Text
kw

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

-- | Key\/value pairs of a property list that is being parsed/constructed.
newtype PropertyList = PropertyList [(Text, Sexp)]

-- | Elements of a list that is being parsed/constructed.
newtype List = List [Sexp]

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

-- | Extract\/inject a position from\/to a 'Sexp'.
position :: Grammar Position (Sexp :- t) (Position :- Sexp :- t)
position :: forall t. Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
position = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso
  (\(s :: Sexp
s@(Fix (Compose (Position
p :< SexpF Sexp
_))) :- t
t) -> Position
p forall h t. h -> t -> h :- t
:- Sexp
s forall h t. h -> t -> h :- t
:- t
t)
  (\(Position
p :- Fix (Compose (Position
_ :< SexpF Sexp
s)) :- t
t) -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
p forall a e. a -> e -> LocatedBy a e
:< SexpF Sexp
s)) forall h t. h -> t -> h :- t
:- t
t)


locate :: Grammar Position (Sexp :- t) (Sexp :- t)
locate :: forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate =
  forall t. Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
position forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead forall p. Grammar p p p
Locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\(Position
_ :- Sexp :- t
t) -> Sexp :- t
t) (\Sexp :- t
t -> Position
dummyPos forall h t. h -> t -> h :- t
:- Sexp :- t
t)


atom :: Grammar Position (Sexp :- t) (Atom :- t)
atom :: forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom = forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      Atom Atom
a -> forall a b. b -> Either a b
Right Atom
a
      Sexp
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"atom" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
other)))
  Atom -> Sexp
Atom


beginParenList :: Grammar Position (Sexp :- t) (List :- t)
beginParenList :: forall t. Grammar Position (Sexp :- t) (List :- t)
beginParenList = forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      ParenList [Sexp]
a -> forall a b. b -> Either a b
Right ([Sexp] -> List
List [Sexp]
a)
      Sexp
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"list" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
other)))
  ([Sexp] -> Sexp
ParenList forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce)


beginBracketList :: Grammar Position (Sexp :- t) (List :- t)
beginBracketList :: forall t. Grammar Position (Sexp :- t) (List :- t)
beginBracketList = forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      BracketList [Sexp]
a -> forall a b. b -> Either a b
Right ([Sexp] -> List
List [Sexp]
a)
      Sexp
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"bracket list" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
other)))
  ([Sexp] -> Sexp
BracketList forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce)


beginBraceList :: Grammar Position (Sexp :- t) (List :- t)
beginBraceList :: forall t. Grammar Position (Sexp :- t) (List :- t)
beginBraceList = forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      BraceList [Sexp]
a -> forall a b. b -> Either a b
Right ([Sexp] -> List
List [Sexp]
a)
      Sexp
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"brace list" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
other)))
  ([Sexp] -> Sexp
BraceList forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce)


endList :: Grammar Position (List :- t) t
endList :: forall t. Grammar Position (List :- t) t
endList = forall p b a. Grammar p b a -> Grammar p a b
Flip forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (\t
t -> [Sexp] -> List
List [] forall h t. h -> t -> h :- t
:- t
t)
  (\(List [Sexp]
lst :- t
t) ->
      case [Sexp]
lst of
        [] -> forall a b. b -> Either a b
Right t
t
        (Sexp
el:[Sexp]
_rest) -> forall a b. a -> Either a b
Left (Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
el)))


-- | Parenthesis list grammar. Runs a specified grammar on a
-- sequence of S-exps in a parenthesized list.
--
-- >>> let grammar = list (el symbol >>> el int) >>> pair
-- >>> encodeWith grammar ("foo", 42)
-- Right "(foo 42)"
list :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'
list :: forall t t'.
Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
list Grammar Position (List :- t) (List :- t')
g = forall t. Grammar Position (Sexp :- t) (List :- t)
beginParenList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall t. Grammar Position (List :- t) t
endList)


-- | Bracket list grammar. Runs a specified grammar on a
-- sequence of S-exps in a bracketed list.
--
-- >>> let grammar = bracketList (rest int)
-- >>> encodeWith grammar [2, 3, 5, 7, 11, 13]
-- Right "[2 3 5 7 11 13]"
bracketList :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'
bracketList :: forall t t'.
Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
bracketList Grammar Position (List :- t) (List :- t')
g = forall t. Grammar Position (Sexp :- t) (List :- t)
beginBracketList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall t. Grammar Position (List :- t) t
endList)


-- | Brace list grammar. Runs a specified grammar on a
-- sequence of S-exps in a list enclosed in braces.
--
-- >>> let grammar = braceList (props (key "x" real >>> key "y" real)) >>> pair
-- >>> encodeWith grammar (3.1415, -1)
-- Right "{:x 3.1415 :y -1}"
braceList :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'
braceList :: forall t t'.
Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
braceList Grammar Position (List :- t) (List :- t')
g = forall t. Grammar Position (Sexp :- t) (List :- t)
beginBraceList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall t. Grammar Position (List :- t) t
endList)

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

-- | Element of a sequence grammar. Runs a specified grammar on a next
-- element of a sequence. The underlying grammar can produce zero or
-- more values on the stack.
--
-- E.g.:
--
-- * @el (sym "lambda")@ consumes a symbol \"lambda\" and produces no
--   values on the stack.
--
-- * @el symbol@ consumes a symbol and produces a 'Text' value
--   corresponding to the symbol.
el :: Grammar Position (Sexp :- t) t' -> Grammar Position (List :- t) (List :- t')
el :: forall t t'.
Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
el Grammar Position (Sexp :- t) t'
g = forall a c b d p t t'.
(Coercible a c, Coercible b d) =>
Grammar p (a :- t) (b :- t') -> Grammar p (c :- t) (d :- t')
coerced (forall p b a. Grammar p b a -> Grammar p a b
Flip forall p a t. Grammar p ([a] :- (a :- t)) ([a] :- t)
cons forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail Grammar Position (Sexp :- t) t'
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a. Grammar p a a
Step)


-- | The rest of a sequence grammar. Runs a specified grammar on each
-- of remaining elements of a sequence and collect them. Expects zero
-- or more elements in the sequence.
--
-- >>> let grammar = list (el (sym "check-primes") >>> rest int)
-- >>> encodeWith grammar [2, 3, 5, 7, 11, 13]
-- Right "(check-primes 2 3 5 7 11 13)"
rest
  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (List :- t) (List :- [a] :- t)
rest :: forall a t.
(forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (List :- t) (List :- ([a] :- t))
rest forall t. Grammar Position (Sexp :- t) (a :- t)
g =
  forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed forall t. Grammar Position (Sexp :- t) (a :- t)
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a. Grammar p a a
Step)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\[a] :- t
a -> [Sexp] -> List
List [] forall h t. h -> t -> h :- t
:- [a] :- t
a) (\(List
_ :- [a] :- t
a) -> [a] :- t
a)

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

beginProperties
  :: Grammar Position (List :- t) (List :- PropertyList :- t)
beginProperties :: forall t.
Grammar Position (List :- t) (List :- (PropertyList :- t))
beginProperties = forall p b a. Grammar p b a -> Grammar p a b
Flip forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (\(List [Sexp]
rest :- PropertyList [(Text, Sexp)]
alist :- t
t) ->
      [Sexp] -> List
List (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
k, Sexp
v) -> [Atom -> Sexp
Atom (Text -> Atom
AtomSymbol (Char
':' Char -> Text -> Text
`TS.cons` Text
k)), Sexp
v]) [(Text, Sexp)]
alist forall a. [a] -> [a] -> [a]
++ [Sexp]
rest) forall h t. h -> t -> h :- t
:- t
t)
  (\(List [Sexp]
lst :- t
t) ->
      let ([Sexp]
rest, [(Text, Sexp)]
alist) = [Sexp] -> [(Text, Sexp)] -> ([Sexp], [(Text, Sexp)])
takePairs [Sexp]
lst [] in
      forall a b. b -> Either a b
Right ([Sexp] -> List
List [Sexp]
rest forall h t. h -> t -> h :- t
:- [(Text, Sexp)] -> PropertyList
PropertyList (forall a. [a] -> [a]
reverse [(Text, Sexp)]
alist) forall h t. h -> t -> h :- t
:- t
t))
  where
    takePairs :: [Sexp] -> [(Text, Sexp)] -> ([Sexp], [(Text, Sexp)])
    takePairs :: [Sexp] -> [(Text, Sexp)] -> ([Sexp], [(Text, Sexp)])
takePairs (Atom (AtomSymbol Text
k) : Sexp
v : [Sexp]
rest) [(Text, Sexp)]
acc =
      case Text -> Maybe (Char, Text)
TS.uncons Text
k of
        Just (Char
':', Text
k') -> [Sexp] -> [(Text, Sexp)] -> ([Sexp], [(Text, Sexp)])
takePairs [Sexp]
rest ((Text
k', Sexp
v) forall a. a -> [a] -> [a]
: [(Text, Sexp)]
acc)
        Maybe (Char, Text)
_              -> (Atom -> Sexp
Atom (Text -> Atom
AtomSymbol Text
k) forall a. a -> [a] -> [a]
: Sexp
v forall a. a -> [a] -> [a]
: [Sexp]
rest, [(Text, Sexp)]
acc)
    takePairs [Sexp]
other [(Text, Sexp)]
acc = ([Sexp]
other, [(Text, Sexp)]
acc)


endProperties
  :: Grammar Position t (PropertyList :- t)
endProperties :: forall t. Grammar Position t (PropertyList :- t)
endProperties = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (\t
t -> [(Text, Sexp)] -> PropertyList
PropertyList [] forall h t. h -> t -> h :- t
:- t
t)
  (\(PropertyList [(Text, Sexp)]
lst :- t
t) ->
      case [(Text, Sexp)]
lst of
        [] -> forall a b. b -> Either a b
Right t
t
        ((Text
k, Sexp
_) : [(Text, Sexp)]
_rest) -> forall a b. a -> Either a b
Left (Text -> Mismatch
unexpected (Text -> Text
ppKey Text
k)))


-- | Property list in a sequence grammar. Collects pairs of keywords
-- and S-expressions from remaining sequence elements and runs a
-- specified grammar on them. Expects zero or more pairs in the
-- sequence. If sequence of pairs interrupts with a non-keyword, the
-- rest of this sequence is left untouched.
--
-- Collected 'PropertyList' is then available for random-access lookup
-- combinators 'key', 'optKey', '.:', '.:?' or bulk extraction
-- 'restKeys' combinator.
--
-- >>> :{
--  let grammar = braceList (
--        props (key "real" real >>> key "img" real) >>> onTail pair >>> el (sym "/") >>>
--        props (key "real" real >>> key "img" real) >>> onTail pair) >>> pair
--  in encodeWith grammar ((0, -1), (1, 0))
-- :}
-- Right "{:real 0 :img -1 / :real 1 :img 0}"
props
  :: Grammar Position (PropertyList :- t) (PropertyList :- t')
  -> Grammar Position (List :- t) (List :- t')
props :: forall t t'.
Grammar Position (PropertyList :- t) (PropertyList :- t')
-> Grammar Position (List :- t) (List :- t')
props Grammar Position (PropertyList :- t) (PropertyList :- t')
g = forall t.
Grammar Position (List :- t) (List :- (PropertyList :- t))
beginProperties forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a b. Grammar p a b -> Grammar p a b
Dive (forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail (Grammar Position (PropertyList :- t) (PropertyList :- t')
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p b a. Grammar p b a -> Grammar p a b
Flip forall t. Grammar Position t (PropertyList :- t)
endProperties))


-- | Property by a key grammar. Looks up an S-expression by a
-- specified key and runs a specified grammar on it. Expects the key
-- to be present.
--
-- Note: performs linear lookup, /O(n)/
key
  :: Text
  -> (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (PropertyList :- t) (PropertyList :- a :- t)
key :: forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (PropertyList :- t) (PropertyList :- (a :- t))
key Text
k forall t. Grammar Position (Sexp :- t) (a :- t)
g =
  forall a c b d p t t'.
(Coercible a c, Coercible b d) =>
Grammar p (a :- t) (b :- t') -> Grammar p (c :- t) (d :- t')
coerced (
    forall p b a. Grammar p b a -> Grammar p a b
Flip (forall k p v t.
Eq k =>
k -> Mismatch -> Grammar p (v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insert Text
k (Text -> Mismatch
expected forall a b. (a -> b) -> a -> b
$ Text -> Text
ppKey Text
k)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a. Grammar p a a
Step forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed forall t. Grammar Position (Sexp :- t) (a :- t)
g) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a b t. Grammar p (a :- (b :- t)) (b :- (a :- t))
swap)


-- | Optional property by a key grammar. Like 'key' but puts 'Nothing'
-- in correspondence to the missing key and 'Just' to the present.
--
-- Note: performs linear lookup, /O(n)/
optKey
  :: Text
  -> (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (PropertyList :- t) (PropertyList :- Maybe a :- t)
optKey :: forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- (Maybe a :- t))
optKey Text
k forall t. Grammar Position (Sexp :- t) (a :- t)
g =
  forall a c b d p t t'.
(Coercible a c, Coercible b d) =>
Grammar p (a :- t) (b :- t') -> Grammar p (c :- t) (d :- t')
coerced (forall p b a. Grammar p b a -> Grammar p a b
Flip (forall k p v t.
Eq k =>
k -> Grammar p (Maybe v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insertMay Text
k) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a. Grammar p a a
Step forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed forall t. Grammar Position (Sexp :- t) (a :- t)
g)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall p a b t. Grammar p (a :- (b :- t)) (b :- (a :- t))
swap)

infix 3 .:
infix 3 .:?


-- | Property by a key grammar. Infix version of 'key'.
(.:)
  :: Text
  -> (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (PropertyList :- t) (PropertyList :- a :- t)
.: :: forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (PropertyList :- t) (PropertyList :- (a :- t))
(.:) = forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (PropertyList :- t) (PropertyList :- (a :- t))
key


-- | Optional property by a key grammar. Infix version of 'optKey'.
(.:?)
  :: Text
  -> (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (PropertyList :- t) (PropertyList :- Maybe a :- t)
.:? :: forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- (Maybe a :- t))
(.:?) = forall a t.
Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- (Maybe a :- t))
optKey


-- | Remaining properties grammar. Extracts all key-value pairs and
-- applies a grammar on every element.
restKeys
  :: (forall t. Grammar Position (Sexp :- Text :- t) (a :- t))
  -> Grammar Position (PropertyList :- t) (PropertyList :- [a] :- t)
restKeys :: forall a t.
(forall t. Grammar Position (Sexp :- (Text :- t)) (a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- ([a] :- t))
restKeys forall t. Grammar Position (Sexp :- (Text :- t)) (a :- t)
f =
  forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed (forall p b a. Grammar p b a -> Grammar p a b
Flip forall p b a t. Grammar p (b :- (a :- t)) ((a, b) :- t)
pair forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall t. Grammar Position (Sexp :- (Text :- t)) (a :- t)
f) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p a. Grammar p a a
Step)) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\[a] :- t
a -> [(Text, Sexp)] -> PropertyList
PropertyList [] forall h t. h -> t -> h :- t
:- [a] :- t
a) (\(PropertyList
_ :- [a] :- t
a) -> [a] :- t
a)


----------------------------------------------------------------------
-- Atoms

-- | Grammar matching integer number atoms to 'Integer' values.
--
-- >>> encodeWith integer (2^100)
-- Right "1267650600228229401496703205376"
integer :: Grammar Position (Sexp :- t) (Integer :- t)
integer :: forall t. Grammar Position (Sexp :- t) (Integer :- t)
integer = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomNumber Scientific
n | Right Integer
i <- (forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Integer) -> forall a b. b -> Either a b
Right Integer
i
      Atom
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"integer" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  (Scientific -> Atom
AtomNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)


-- | Grammar matching integer number atoms to 'Int' values.
--
-- >>> encodeWith int (2^63)
-- Right "-9223372036854775808"
--
-- >>> encodeWith int (2^63-1)
-- Right "9223372036854775807"
int :: Grammar Position (Sexp :- t) (Int :- t)
int :: forall t. Grammar Position (Sexp :- t) (Int :- t)
int = forall t. Grammar Position (Sexp :- t) (Integer :- t)
integer forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- | Grammar matching fractional number atoms to 'Scientific' values.
--
-- >>> encodeWith real (3.141592653589793^3)
-- Right "31.006276680299813114880451174049119330924860257"
real :: Grammar Position (Sexp :- t) (Scientific :- t)
real :: forall t. Grammar Position (Sexp :- t) (Scientific :- t)
real = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomNumber Scientific
r -> forall a b. b -> Either a b
Right Scientific
r
      Atom
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"real" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  Scientific -> Atom
AtomNumber


-- | Grammar matching fractional number atoms to 'Double' values.
--
-- >>> encodeWith double (3.141592653589793^3)
-- Right "31.006276680299816"
double :: Grammar Position (Sexp :- t) (Double :- t)
double :: forall t. Grammar Position (Sexp :- t) (Double :- t)
double = forall t. Grammar Position (Sexp :- t) (Scientific :- t)
real forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso forall a. RealFloat a => Scientific -> a
toRealFloat forall a. RealFloat a => a -> Scientific
fromFloatDigits


-- | Grammar matching string literal atoms to 'Text' values.
--
-- >>> let grammar = list (el string >>> el int) >>> pair
-- >>> encodeWith grammar ("some-string", 42)
-- Right "(\"some-string\" 42)"
string :: Grammar Position (Sexp :- t) (Text :- t)
string :: forall t. Grammar Position (Sexp :- t) (Text :- t)
string = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomString Text
s -> forall a b. b -> Either a b
Right Text
s
      Atom
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"string" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  Text -> Atom
AtomString


-- | Grammar matching symbol literal atoms to 'Text' values.
--
-- >>> encodeWith symbol "some-symbol"
-- Right "some-symbol"
symbol :: Grammar Position (Sexp :- t) (Text :- t)
symbol :: forall t. Grammar Position (Sexp :- t) (Text :- t)
symbol = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomSymbol Text
s -> forall a b. b -> Either a b
Right Text
s
      Atom
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"symbol" forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  Text -> Atom
AtomSymbol


-- | Grammar matching symbol literal atoms starting with \':\' to
-- 'Text' values without the colon char.
--
-- >>> encodeWith keyword "username"
-- Right ":username"
keyword :: Grammar Position (Sexp :- t) (Text :- t)
keyword :: forall t. Grammar Position (Sexp :- t) (Text :- t)
keyword = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomSymbol Text
s | Just (Char
':', Text
k) <- Text -> Maybe (Char, Text)
TS.uncons Text
s -> forall a b. b -> Either a b
Right Text
k
      Atom
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"keyword" forall a. Semigroup a => a -> a -> a
<>
                     Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  (Text -> Atom
AtomSymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
TS.cons Char
':')


-- | Grammar matching symbol literal atoms to a specified symbol.
--
-- >>> let grammar = list (el (sym "username") >>> el string)
-- >>> encodeWith grammar "Julius Caesar"
-- Right "(username \"Julius Caesar\")"
sym :: Text -> Grammar Position (Sexp :- t) t
sym :: forall t. Text -> Grammar Position (Sexp :- t) t
sym Text
s = forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p b a. Grammar p b a -> Grammar p a b
Flip (forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (Text -> Atom
AtomSymbol Text
s forall h t. h -> t -> h :- t
:-)
  (\(Atom
a :- t
t) ->
      case Atom
a of
        AtomSymbol Text
s' | Text
s forall a. Eq a => a -> a -> Bool
== Text
s' -> forall a b. b -> Either a b
Right t
t
        Atom
other -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Mismatch
expected (Text
"symbol " forall a. Semigroup a => a -> a -> a
<> Text
s) forall a. Semigroup a => a -> a -> a
<>
                        Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))


-- | Grammar matching symbol literal atoms to a specified symbol
-- prepended with \':\'.
--
-- >>> let grammar = list (el (kwd "password") >>> el int)
-- >>> encodeWith grammar 42
-- Right "(:password 42)"
kwd :: Text -> Grammar Position (Sexp :- t) t
kwd :: forall t. Text -> Grammar Position (Sexp :- t) t
kwd Text
s =
  let k :: Text
k = Char -> Text -> Text
TS.cons Char
':' Text
s
  in forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall p b a. Grammar p b a -> Grammar p a b
Flip (forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
       (Text -> Atom
AtomSymbol Text
k forall h t. h -> t -> h :- t
:-)
       (\(Atom
a :- t
t) ->
           case Atom
a of
             AtomSymbol Text
s' | Text
k forall a. Eq a => a -> a -> Bool
== Text
s' -> forall a b. b -> Either a b
Right t
t
             Atom
other -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Mismatch
expected (Text -> Text
ppKey Text
s) forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))


prefix :: Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix :: forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
m = forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      Modified Prefix
m' Sexp
a | Prefix
m' forall a. Eq a => a -> a -> Bool
== Prefix
m -> forall a b. b -> Either a b
Right Sexp
a
      Sexp
other -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected (Sexp -> Text
ppBrief (Prefix -> Sexp -> Sexp
Modified Prefix
m (Text -> Sexp
Symbol Text
"-prefixed"))) forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief Sexp
other)))
  (Prefix -> Sexp -> Sexp
Modified Prefix
m)

-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a
-- @Sexp@ under the hash prefix.
--
-- >>> encodeWith (hashed symbol) "foo"
-- Right "#foo"
hashed :: Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
hashed :: forall t t'.
Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
hashed Grammar Position (Sexp :- t) t'
g = forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
Hash forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (Sexp :- t) t'
g

-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a
-- @Sexp@ under the quotation.
--
-- >>> encodeWith (quoted symbol) "foo"
-- Right "'foo"
quoted :: Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
quoted :: forall t t'.
Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
quoted Grammar Position (Sexp :- t) t'
g = forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
Quote forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (Sexp :- t) t'
g


-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a
-- @Sexp@ under the prefix.
--
-- >>> encodeWith (prefixed Backtick symbol) "foo"
-- Right "`foo"
prefixed :: Prefix -> Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
prefixed :: forall t t'.
Prefix
-> Grammar Position (Sexp :- t) t'
-> Grammar Position (Sexp :- t) t'
prefixed Prefix
m Grammar Position (Sexp :- t) t'
g = forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
m forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (Sexp :- t) t'
g