{-# 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 (Text -> Text) -> (Sexp -> Text) -> Sexp -> Text
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 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
25
       then Int64 -> Text -> Text
TL.take Int64
25 Text
pp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
       else Text
pp

ppKey :: Text -> Text
ppKey :: Text -> Text
ppKey Text
kw = Text
"keyword :" Text -> Text -> Text
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 :: Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
position = ((Sexp :- t) -> Position :- (Sexp :- t))
-> ((Position :- (Sexp :- t)) -> Sexp :- t)
-> Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
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 Position -> (Sexp :- t) -> Position :- (Sexp :- t)
forall h t. h -> t -> h :- t
:- Sexp
s Sexp -> t -> Sexp :- t
forall h t. h -> t -> h :- t
:- t
t)
  (\(Position
p :- Fix (Compose (Position
_ :< SexpF Sexp
s)) :- t
t) -> Compose (LocatedBy Position) SexpF Sexp -> Sexp
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LocatedBy Position (SexpF Sexp)
-> Compose (LocatedBy Position) SexpF Sexp
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Position
p Position -> SexpF Sexp -> LocatedBy Position (SexpF Sexp)
forall a e. a -> e -> LocatedBy a e
:< SexpF Sexp
s)) Sexp -> t -> Sexp :- t
forall h t. h -> t -> h :- t
:- t
t)


locate :: Grammar Position (Sexp :- t) (Sexp :- t)
locate :: Grammar Position (Sexp :- t) (Sexp :- t)
locate =
  Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
forall t. Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
position Grammar Position (Sexp :- t) (Position :- (Sexp :- t))
-> Grammar Position (Position :- (Sexp :- t)) (Sexp :- t)
-> Grammar Position (Sexp :- t) (Sexp :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  Grammar Position Position Position
-> Grammar
     Position (Position :- (Sexp :- t)) (Position :- (Sexp :- t))
forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead Grammar Position Position Position
forall p. Grammar p p p
Locate Grammar
  Position (Position :- (Sexp :- t)) (Position :- (Sexp :- t))
-> Grammar Position (Position :- (Sexp :- t)) (Sexp :- t)
-> Grammar Position (Position :- (Sexp :- t)) (Sexp :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  ((Position :- (Sexp :- t)) -> Sexp :- t)
-> ((Sexp :- t) -> Position :- (Sexp :- t))
-> Grammar Position (Position :- (Sexp :- t)) (Sexp :- t)
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 Position -> (Sexp :- t) -> Position :- (Sexp :- t)
forall h t. h -> t -> h :- t
:- Sexp :- t
t)


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


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


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


endList :: Grammar Position (List :- t) t
endList :: Grammar Position (List :- t) t
endList = Grammar Position t (List :- t) -> Grammar Position (List :- t) t
forall p b a. Grammar p b a -> Grammar p a b
Flip (Grammar Position t (List :- t) -> Grammar Position (List :- t) t)
-> Grammar Position t (List :- t) -> Grammar Position (List :- t) t
forall a b. (a -> b) -> a -> b
$ (t -> List :- t)
-> ((List :- t) -> Either Mismatch t)
-> Grammar Position t (List :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (\t
t -> [Sexp] -> List
List [] List -> t -> List :- t
forall h t. h -> t -> h :- t
:- t
t)
  (\(List [Sexp]
lst :- t
t) ->
      case [Sexp]
lst of
        [] -> t -> Either Mismatch t
forall a b. b -> Either a b
Right t
t
        (Sexp
el:[Sexp]
_rest) -> Mismatch -> Either Mismatch t
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 :: Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
list Grammar Position (List :- t) (List :- t')
g = Grammar Position (Sexp :- t) (List :- t)
forall t. Grammar Position (Sexp :- t) (List :- t)
beginParenList Grammar Position (Sexp :- t) (List :- t)
-> Grammar Position (List :- t) t'
-> Grammar Position (Sexp :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t) t' -> Grammar Position (List :- t) t'
forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g Grammar Position (List :- t) (List :- t')
-> Grammar Position (List :- t') t'
-> Grammar Position (List :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t') t'
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 :: Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
bracketList Grammar Position (List :- t) (List :- t')
g = Grammar Position (Sexp :- t) (List :- t)
forall t. Grammar Position (Sexp :- t) (List :- t)
beginBracketList Grammar Position (Sexp :- t) (List :- t)
-> Grammar Position (List :- t) t'
-> Grammar Position (Sexp :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t) t' -> Grammar Position (List :- t) t'
forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g Grammar Position (List :- t) (List :- t')
-> Grammar Position (List :- t') t'
-> Grammar Position (List :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t') t'
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 :: Grammar Position (List :- t) (List :- t')
-> Grammar Position (Sexp :- t) t'
braceList Grammar Position (List :- t) (List :- t')
g = Grammar Position (Sexp :- t) (List :- t)
forall t. Grammar Position (Sexp :- t) (List :- t)
beginBraceList Grammar Position (Sexp :- t) (List :- t)
-> Grammar Position (List :- t) t'
-> Grammar Position (Sexp :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t) t' -> Grammar Position (List :- t) t'
forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (List :- t) (List :- t')
g Grammar Position (List :- t) (List :- t')
-> Grammar Position (List :- t') t'
-> Grammar Position (List :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- t') t'
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 :: Grammar Position (Sexp :- t) t'
-> Grammar Position (List :- t) (List :- t')
el Grammar Position (Sexp :- t) t'
g = Grammar Position ([Sexp] :- t) ([Sexp] :- t')
-> Grammar Position (List :- t) (List :- t')
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 (Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t)
-> Grammar Position ([Sexp] :- t) ([Sexp] :- (Sexp :- t))
forall p b a. Grammar p b a -> Grammar p a b
Flip Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t)
forall p a t. Grammar p ([a] :- (a :- t)) ([a] :- t)
cons Grammar Position ([Sexp] :- t) ([Sexp] :- (Sexp :- t))
-> Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t')
-> Grammar Position ([Sexp] :- t) ([Sexp] :- t')
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'
-> Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t')
forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail Grammar Position (Sexp :- t) t'
g Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t')
-> Grammar Position ([Sexp] :- t') ([Sexp] :- t')
-> Grammar Position ([Sexp] :- (Sexp :- t)) ([Sexp] :- t')
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') ([Sexp] :- t')
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 t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (List :- t) (List :- ([a] :- t))
rest forall t. Grammar Position (Sexp :- t) (a :- t)
g =
  (List -> [Sexp])
-> ([Sexp] -> List) -> Grammar Position (List :- t) ([Sexp] :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso List -> [Sexp]
coerce [Sexp] -> List
coerce Grammar Position (List :- t) ([Sexp] :- t)
-> Grammar Position ([Sexp] :- t) (List :- ([a] :- t))
-> Grammar Position (List :- t) (List :- ([a] :- t))
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] [a]
-> Grammar Position ([Sexp] :- t) ([a] :- t)
forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (Grammar Position Sexp a -> Grammar Position [Sexp] [a]
forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (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)
forall t. Grammar Position (Sexp :- t) (a :- t)
g Grammar Position Sexp a
-> Grammar Position a a -> Grammar Position Sexp a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position a a
forall p a. Grammar p a a
Step)) Grammar Position ([Sexp] :- t) ([a] :- t)
-> Grammar Position ([a] :- t) (List :- ([a] :- t))
-> Grammar Position ([Sexp] :- t) (List :- ([a] :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  (([a] :- t) -> List :- ([a] :- t))
-> ((List :- ([a] :- t)) -> [a] :- t)
-> Grammar Position ([a] :- t) (List :- ([a] :- t))
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\[a] :- t
a -> [Sexp] -> List
List [] List -> ([a] :- t) -> List :- ([a] :- t)
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 :: Grammar Position (List :- t) (List :- (PropertyList :- t))
beginProperties = Grammar Position (List :- (PropertyList :- t)) (List :- t)
-> Grammar Position (List :- t) (List :- (PropertyList :- t))
forall p b a. Grammar p b a -> Grammar p a b
Flip (Grammar Position (List :- (PropertyList :- t)) (List :- t)
 -> Grammar Position (List :- t) (List :- (PropertyList :- t)))
-> Grammar Position (List :- (PropertyList :- t)) (List :- t)
-> Grammar Position (List :- t) (List :- (PropertyList :- t))
forall a b. (a -> b) -> a -> b
$ ((List :- (PropertyList :- t)) -> List :- t)
-> ((List :- t) -> Either Mismatch (List :- (PropertyList :- t)))
-> Grammar Position (List :- (PropertyList :- t)) (List :- t)
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 (((Text, Sexp) -> [Sexp]) -> [(Text, Sexp)] -> [Sexp]
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 [Sexp] -> [Sexp] -> [Sexp]
forall a. [a] -> [a] -> [a]
++ [Sexp]
rest) List -> t -> List :- t
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
      (List :- (PropertyList :- t))
-> Either Mismatch (List :- (PropertyList :- t))
forall a b. b -> Either a b
Right ([Sexp] -> List
List [Sexp]
rest List -> (PropertyList :- t) -> List :- (PropertyList :- t)
forall h t. h -> t -> h :- t
:- [(Text, Sexp)] -> PropertyList
PropertyList ([(Text, Sexp)] -> [(Text, Sexp)]
forall a. [a] -> [a]
reverse [(Text, Sexp)]
alist) PropertyList -> t -> PropertyList :- t
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) (Text, Sexp) -> [(Text, Sexp)] -> [(Text, Sexp)]
forall a. a -> [a] -> [a]
: [(Text, Sexp)]
acc)
        Maybe (Char, Text)
_              -> (Atom -> Sexp
Atom (Text -> Atom
AtomSymbol Text
k) Sexp -> [Sexp] -> [Sexp]
forall a. a -> [a] -> [a]
: Sexp
v Sexp -> [Sexp] -> [Sexp]
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 :: Grammar Position t (PropertyList :- t)
endProperties = (t -> PropertyList :- t)
-> ((PropertyList :- t) -> Either Mismatch t)
-> Grammar Position t (PropertyList :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (\t
t -> [(Text, Sexp)] -> PropertyList
PropertyList [] PropertyList -> t -> PropertyList :- t
forall h t. h -> t -> h :- t
:- t
t)
  (\(PropertyList [(Text, Sexp)]
lst :- t
t) ->
      case [(Text, Sexp)]
lst of
        [] -> t -> Either Mismatch t
forall a b. b -> Either a b
Right t
t
        ((Text
k, Sexp
_) : [(Text, Sexp)]
_rest) -> Mismatch -> Either Mismatch t
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 :: Grammar Position (PropertyList :- t) (PropertyList :- t')
-> Grammar Position (List :- t) (List :- t')
props Grammar Position (PropertyList :- t) (PropertyList :- t')
g = Grammar Position (List :- t) (List :- (PropertyList :- t))
forall t.
Grammar Position (List :- t) (List :- (PropertyList :- t))
beginProperties Grammar Position (List :- t) (List :- (PropertyList :- t))
-> Grammar Position (List :- (PropertyList :- t)) (List :- t')
-> Grammar Position (List :- t) (List :- t')
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (List :- (PropertyList :- t)) (List :- t')
-> Grammar Position (List :- (PropertyList :- t)) (List :- t')
forall p a b. Grammar p a b -> Grammar p a b
Dive (Grammar Position (PropertyList :- t) t'
-> Grammar Position (List :- (PropertyList :- t)) (List :- t')
forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail (Grammar Position (PropertyList :- t) (PropertyList :- t')
g Grammar Position (PropertyList :- t) (PropertyList :- t')
-> Grammar Position (PropertyList :- t') t'
-> Grammar Position (PropertyList :- t) t'
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position t' (PropertyList :- t')
-> Grammar Position (PropertyList :- t') t'
forall p b a. Grammar p b a -> Grammar p a b
Flip Grammar Position t' (PropertyList :- t')
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 :: 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 =
  Grammar Position ([(Text, Sexp)] :- t) ([(Text, Sexp)] :- (a :- t))
-> Grammar Position (PropertyList :- t) (PropertyList :- (a :- t))
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 (
    Grammar
  Position (Sexp :- ([(Text, Sexp)] :- t)) ([(Text, Sexp)] :- t)
-> Grammar
     Position ([(Text, Sexp)] :- t) (Sexp :- ([(Text, Sexp)] :- t))
forall p b a. Grammar p b a -> Grammar p a b
Flip (Text
-> Mismatch
-> Grammar
     Position (Sexp :- ([(Text, Sexp)] :- t)) ([(Text, Sexp)] :- t)
forall k p v t.
Eq k =>
k -> Mismatch -> Grammar p (v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insert Text
k (Text -> Mismatch
expected (Text -> Mismatch) -> Text -> Mismatch
forall a b. (a -> b) -> a -> b
$ Text -> Text
ppKey Text
k)) Grammar
  Position ([(Text, Sexp)] :- t) (Sexp :- ([(Text, Sexp)] :- t))
-> Grammar
     Position
     (Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (a :- t))
-> Grammar
     Position ([(Text, Sexp)] :- t) ([(Text, Sexp)] :- (a :- t))
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 :- ([(Text, Sexp)] :- t))
  (Sexp :- ([(Text, Sexp)] :- t))
forall p a. Grammar p a a
Step Grammar
  Position
  (Sexp :- ([(Text, Sexp)] :- t))
  (Sexp :- ([(Text, Sexp)] :- t))
-> Grammar
     Position
     (Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (a :- t))
-> Grammar
     Position
     (Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (a :- t))
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 a
-> Grammar
     Position
     (Sexp :- ([(Text, Sexp)] :- t))
     (a :- ([(Text, Sexp)] :- t))
forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (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)
forall t. Grammar Position (Sexp :- t) (a :- t)
g) Grammar
  Position
  (Sexp :- ([(Text, Sexp)] :- t))
  (a :- ([(Text, Sexp)] :- t))
-> Grammar
     Position (a :- ([(Text, Sexp)] :- t)) ([(Text, Sexp)] :- (a :- t))
-> Grammar
     Position
     (Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (a :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    Grammar
  Position (a :- ([(Text, Sexp)] :- t)) ([(Text, Sexp)] :- (a :- t))
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 :: 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 =
  Grammar
  Position ([(Text, Sexp)] :- t) ([(Text, Sexp)] :- (Maybe a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- (Maybe a :- t))
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 (Grammar
  Position
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
  ([(Text, Sexp)] :- t)
-> Grammar
     Position
     ([(Text, Sexp)] :- t)
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
forall p b a. Grammar p b a -> Grammar p a b
Flip (Text
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- t)
forall k p v t.
Eq k =>
k -> Grammar p (Maybe v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insertMay Text
k) Grammar
  Position
  ([(Text, Sexp)] :- t)
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (Maybe a :- t))
-> Grammar
     Position ([(Text, Sexp)] :- t) ([(Text, Sexp)] :- (Maybe a :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    Grammar
  Position
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
forall p a. Grammar p a a
Step Grammar
  Position
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (Maybe a :- t))
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (Maybe a :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    Grammar Position (Maybe Sexp) (Maybe a)
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     (Maybe a :- ([(Text, Sexp)] :- t))
forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (Grammar Position Sexp a -> Grammar Position (Maybe Sexp) (Maybe a)
forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (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)
forall t. Grammar Position (Sexp :- t) (a :- t)
g)) Grammar
  Position
  (Maybe Sexp :- ([(Text, Sexp)] :- t))
  (Maybe a :- ([(Text, Sexp)] :- t))
-> Grammar
     Position
     (Maybe a :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (Maybe a :- t))
-> Grammar
     Position
     (Maybe Sexp :- ([(Text, Sexp)] :- t))
     ([(Text, Sexp)] :- (Maybe a :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    Grammar
  Position
  (Maybe a :- ([(Text, Sexp)] :- t))
  ([(Text, Sexp)] :- (Maybe a :- t))
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)
.: :: Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar Position (PropertyList :- t) (PropertyList :- (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)
.:? :: Text
-> (forall t. Grammar Position (Sexp :- t) (a :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- (Maybe 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 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 =
  (PropertyList -> [(Text, Sexp)])
-> ([(Text, Sexp)] -> PropertyList)
-> Grammar Position (PropertyList :- t) ([(Text, Sexp)] :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso PropertyList -> [(Text, Sexp)]
coerce [(Text, Sexp)] -> PropertyList
coerce Grammar Position (PropertyList :- t) ([(Text, Sexp)] :- t)
-> Grammar
     Position ([(Text, Sexp)] :- t) (PropertyList :- ([a] :- t))
-> Grammar
     Position (PropertyList :- t) (PropertyList :- ([a] :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  Grammar Position [(Text, Sexp)] [a]
-> Grammar Position ([(Text, Sexp)] :- t) ([a] :- t)
forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead (Grammar Position (Text, Sexp) a
-> Grammar Position [(Text, Sexp)] [a]
forall (f :: * -> *) p a1 b1.
Traversable f =>
Grammar p a1 b1 -> Grammar p (f a1) (f b1)
Traverse (Grammar Position ((Text, Sexp) :- Void) (a :- Void)
-> Grammar Position (Text, Sexp) a
forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed (Grammar Position (Sexp :- (Text :- Void)) ((Text, Sexp) :- Void)
-> Grammar Position ((Text, Sexp) :- Void) (Sexp :- (Text :- Void))
forall p b a. Grammar p b a -> Grammar p a b
Flip Grammar Position (Sexp :- (Text :- Void)) ((Text, Sexp) :- Void)
forall p b a t. Grammar p (b :- (a :- t)) ((a, b) :- t)
pair Grammar Position ((Text, Sexp) :- Void) (Sexp :- (Text :- Void))
-> Grammar Position (Sexp :- (Text :- Void)) (a :- Void)
-> Grammar Position ((Text, Sexp) :- Void) (a :- Void)
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 :- (Text :- Void)) (a :- Void)
forall t. Grammar Position (Sexp :- (Text :- t)) (a :- t)
f) Grammar Position (Text, Sexp) a
-> Grammar Position a a -> Grammar Position (Text, Sexp) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position a a
forall p a. Grammar p a a
Step)) Grammar Position ([(Text, Sexp)] :- t) ([a] :- t)
-> Grammar Position ([a] :- t) (PropertyList :- ([a] :- t))
-> Grammar
     Position ([(Text, Sexp)] :- t) (PropertyList :- ([a] :- t))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  (([a] :- t) -> PropertyList :- ([a] :- t))
-> ((PropertyList :- ([a] :- t)) -> [a] :- t)
-> Grammar Position ([a] :- t) (PropertyList :- ([a] :- t))
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\[a] :- t
a -> [(Text, Sexp)] -> PropertyList
PropertyList [] PropertyList -> ([a] :- t) -> PropertyList :- ([a] :- t)
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 :: Grammar Position (Sexp :- t) (Integer :- t)
integer = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) (Integer :- t)
-> Grammar Position (Sexp :- t) (Integer :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Atom -> Either Mismatch Integer)
-> (Integer -> Atom) -> Grammar Position (Atom :- t) (Integer :- t)
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 <- (Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Integer) -> Integer -> Either Mismatch Integer
forall a b. b -> Either a b
Right Integer
i
      Atom
other -> Mismatch -> Either Mismatch Integer
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"integer" Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  (Scientific -> Atom
AtomNumber (Scientific -> Atom) -> (Integer -> Scientific) -> Integer -> Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
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 :: Grammar Position (Sexp :- t) (Int :- t)
int = Grammar Position (Sexp :- t) (Integer :- t)
forall t. Grammar Position (Sexp :- t) (Integer :- t)
integer Grammar Position (Sexp :- t) (Integer :- t)
-> Grammar Position (Integer :- t) (Int :- t)
-> Grammar Position (Sexp :- t) (Int :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Integer -> Int)
-> (Int -> Integer) -> Grammar Position (Integer :- t) (Int :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int -> Integer
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 :: Grammar Position (Sexp :- t) (Scientific :- t)
real = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) (Scientific :- t)
-> Grammar Position (Sexp :- t) (Scientific :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Atom -> Either Mismatch Scientific)
-> (Scientific -> Atom)
-> Grammar Position (Atom :- t) (Scientific :- t)
forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomNumber Scientific
r -> Scientific -> Either Mismatch Scientific
forall a b. b -> Either a b
Right Scientific
r
      Atom
other -> Mismatch -> Either Mismatch Scientific
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"real" Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
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 :: Grammar Position (Sexp :- t) (Double :- t)
double = Grammar Position (Sexp :- t) (Scientific :- t)
forall t. Grammar Position (Sexp :- t) (Scientific :- t)
real Grammar Position (Sexp :- t) (Scientific :- t)
-> Grammar Position (Scientific :- t) (Double :- t)
-> Grammar Position (Sexp :- t) (Double :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Scientific -> Double)
-> (Double -> Scientific)
-> Grammar Position (Scientific :- t) (Double :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Double -> Scientific
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 :: Grammar Position (Sexp :- t) (Text :- t)
string = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) (Text :- t)
-> Grammar Position (Sexp :- t) (Text :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Atom -> Either Mismatch Text)
-> (Text -> Atom) -> Grammar Position (Atom :- t) (Text :- t)
forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomString Text
s -> Text -> Either Mismatch Text
forall a b. b -> Either a b
Right Text
s
      Atom
other -> Mismatch -> Either Mismatch Text
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"string" Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
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 :: Grammar Position (Sexp :- t) (Text :- t)
symbol = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) (Text :- t)
-> Grammar Position (Sexp :- t) (Text :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Atom -> Either Mismatch Text)
-> (Text -> Atom) -> Grammar Position (Atom :- t) (Text :- t)
forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi
  (\case
      AtomSymbol Text
s -> Text -> Either Mismatch Text
forall a b. b -> Either a b
Right Text
s
      Atom
other -> Mismatch -> Either Mismatch Text
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"symbol" Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
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 :: Grammar Position (Sexp :- t) (Text :- t)
keyword = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) (Text :- t)
-> Grammar Position (Sexp :- t) (Text :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Atom -> Either Mismatch Text)
-> (Text -> Atom) -> Grammar Position (Atom :- t) (Text :- t)
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 -> Text -> Either Mismatch Text
forall a b. b -> Either a b
Right Text
k
      Atom
other -> Mismatch -> Either Mismatch Text
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"keyword" Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<>
                     Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))
  (Text -> Atom
AtomSymbol (Text -> Atom) -> (Text -> Text) -> Text -> Atom
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 :: Text -> Grammar Position (Sexp :- t) t
sym Text
s = Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) t -> Grammar Position (Sexp :- t) t
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position t (Atom :- t) -> Grammar Position (Atom :- t) t
forall p b a. Grammar p b a -> Grammar p a b
Flip ((t -> Atom :- t)
-> ((Atom :- t) -> Either Mismatch t)
-> Grammar Position t (Atom :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
  (Text -> Atom
AtomSymbol Text
s Atom -> t -> Atom :- t
forall h t. h -> t -> h :- t
:-)
  (\(Atom
a :- t
t) ->
      case Atom
a of
        AtomSymbol Text
s' | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s' -> t -> Either Mismatch t
forall a b. b -> Either a b
Right t
t
        Atom
other -> Mismatch -> Either Mismatch t
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch t) -> Mismatch -> Either Mismatch t
forall a b. (a -> b) -> a -> b
$ Text -> Mismatch
expected (Text
"symbol " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<>
                        Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
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 :: Text -> Grammar Position (Sexp :- t) t
kwd Text
s =
  let k :: Text
k = Char -> Text -> Text
TS.cons Char
':' Text
s
  in Grammar Position (Sexp :- t) (Atom :- t)
forall t. Grammar Position (Sexp :- t) (Atom :- t)
atom Grammar Position (Sexp :- t) (Atom :- t)
-> Grammar Position (Atom :- t) t -> Grammar Position (Sexp :- t) t
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position t (Atom :- t) -> Grammar Position (Atom :- t) t
forall p b a. Grammar p b a -> Grammar p a b
Flip ((t -> Atom :- t)
-> ((Atom :- t) -> Either Mismatch t)
-> Grammar Position t (Atom :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
       (Text -> Atom
AtomSymbol Text
k Atom -> t -> Atom :- t
forall h t. h -> t -> h :- t
:-)
       (\(Atom
a :- t
t) ->
           case Atom
a of
             AtomSymbol Text
s' | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s' -> t -> Either Mismatch t
forall a b. b -> Either a b
Right t
t
             Atom
other -> Mismatch -> Either Mismatch t
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch t) -> Mismatch -> Either Mismatch t
forall a b. (a -> b) -> a -> b
$ Text -> Mismatch
expected (Text -> Text
ppKey Text
s) Mismatch -> Mismatch -> Mismatch
forall a. Semigroup a => a -> a -> a
<> Text -> Mismatch
unexpected (Sexp -> Text
ppBrief (Sexp -> Text) -> Sexp -> Text
forall a b. (a -> b) -> a -> b
$ Atom -> Sexp
Atom Atom
other)))


prefix :: Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix :: Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
m = Grammar Position (Sexp :- t) (Sexp :- t)
forall t. Grammar Position (Sexp :- t) (Sexp :- t)
locate Grammar Position (Sexp :- t) (Sexp :- t)
-> Grammar Position (Sexp :- t) (Sexp :- t)
-> Grammar Position (Sexp :- t) (Sexp :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Sexp -> Either Mismatch Sexp)
-> (Sexp -> Sexp) -> Grammar Position (Sexp :- t) (Sexp :- t)
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' Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
m -> Sexp -> Either Mismatch Sexp
forall a b. b -> Either a b
Right Sexp
a
      Sexp
other -> Mismatch -> Either Mismatch Sexp
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"))) Mismatch -> Mismatch -> Mismatch
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 :: Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
hashed Grammar Position (Sexp :- t) t'
g = Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
Hash Grammar Position (Sexp :- t) (Sexp :- t)
-> Grammar Position (Sexp :- t) t'
-> Grammar Position (Sexp :- t) t'
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 :: Grammar Position (Sexp :- t) t' -> Grammar Position (Sexp :- t) t'
quoted Grammar Position (Sexp :- t) t'
g = Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
Quote Grammar Position (Sexp :- t) (Sexp :- t)
-> Grammar Position (Sexp :- t) t'
-> Grammar Position (Sexp :- t) t'
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 :: Prefix
-> Grammar Position (Sexp :- t) t'
-> Grammar Position (Sexp :- t) t'
prefixed Prefix
m Grammar Position (Sexp :- t) t'
g = Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
forall t. Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)
prefix Prefix
m Grammar Position (Sexp :- t) (Sexp :- t)
-> Grammar Position (Sexp :- t) t'
-> Grammar Position (Sexp :- t) t'
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