{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module : Data.Herb
-- Description : Encoding of data into Prolog-like Herbrandt universa.
--
-- Herb provides manipulation and serialization of "Herbrandt universum" data
-- structures. Most users will know these from Prolog. Module provides similar
-- tools as Aeson, together with the typeclasses `ToHerb` and `FromHerb` (with
-- Generics-derived defaults) and several utilities for writing custom parsers
-- for complicated stuff.
--
-- Only minimal instances are provided in this module. For quick start, utility
-- instances for common types can be obtained from "Data.Herb.Instances".
module Data.Herb
  ( -- * Identifiers
    Ident
  , unpackIdent
  , packIdent
  , -- * Herb representation
    Herb(..)
  , formatHerb
  , encodeHerb
  , isEscapable
  , isUnquotedIdentChar
  , escAtom
  , ShowAtom(..)
  , PlainHerb(..)
  , -- * Serializing to Herb
    ToHerb(..)
  , ToHerb1(..)
  , -- * Deserializing from Herb
    Parser(..)
  , FromHerb(..)
  , FromHerb1(..)
  , fromHerb
  , -- ** Deserialization Parser utilities
    gets
  , get
  , put
  , modify
  , local
  , contexted
  , -- *** Parsing of Atoms
    satisfyAtom
  , exactAtom
  , maybeAtom
  , atomShow
  , atomRead
  , -- *** Parsing of Structs
    exactStruct
  , parseArg
  , popArg
  , popArg'
  , endOfArgs
  , singleArg
  ) where

import Control.Applicative
import Control.Monad
import Data.Char (isSpace)
import qualified Data.Text as T
import GHC.Generics
import Text.Read (readMaybe)

-- | Convenience shortcut for the identifier type. Currently an alias for
-- `T.Text` (creating `Ident`s is thus quite easy with
-- @-XOverloadedStrings@ or similar tools.
--
-- (Using `Ident` instead of `T.Text` may help preserve compatibility with
-- future versions.)
type Ident = T.Text

-- | Convert `Ident` to `String`.
unpackIdent :: Ident -> String
unpackIdent :: Ident -> String
unpackIdent = Ident -> String
T.unpack

-- | Convert `String` to `Ident`.
packIdent :: String -> Ident
packIdent :: String -> Ident
packIdent = String -> Ident
T.pack

-- | Herbrandt universum, consisting of atoms and n-ary structures.
data Herb
  = Struct Ident [Herb] -- ^ Structure with a name and parameters, such as @structure(param1, param2)@.
  | Atom Ident -- ^ A single atom with no parameters, such as @5@ or @Nothing@.
  deriving (Int -> Herb -> ShowS
[Herb] -> ShowS
Herb -> String
(Int -> Herb -> ShowS)
-> (Herb -> String) -> ([Herb] -> ShowS) -> Show Herb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Herb -> ShowS
showsPrec :: Int -> Herb -> ShowS
$cshow :: Herb -> String
show :: Herb -> String
$cshowList :: [Herb] -> ShowS
showList :: [Herb] -> ShowS
Show, ReadPrec [Herb]
ReadPrec Herb
Int -> ReadS Herb
ReadS [Herb]
(Int -> ReadS Herb)
-> ReadS [Herb] -> ReadPrec Herb -> ReadPrec [Herb] -> Read Herb
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Herb
readsPrec :: Int -> ReadS Herb
$creadList :: ReadS [Herb]
readList :: ReadS [Herb]
$creadPrec :: ReadPrec Herb
readPrec :: ReadPrec Herb
$creadListPrec :: ReadPrec [Herb]
readListPrec :: ReadPrec [Herb]
Read, Herb -> Herb -> Bool
(Herb -> Herb -> Bool) -> (Herb -> Herb -> Bool) -> Eq Herb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Herb -> Herb -> Bool
== :: Herb -> Herb -> Bool
$c/= :: Herb -> Herb -> Bool
/= :: Herb -> Herb -> Bool
Eq, Eq Herb
Eq Herb =>
(Herb -> Herb -> Ordering)
-> (Herb -> Herb -> Bool)
-> (Herb -> Herb -> Bool)
-> (Herb -> Herb -> Bool)
-> (Herb -> Herb -> Bool)
-> (Herb -> Herb -> Herb)
-> (Herb -> Herb -> Herb)
-> Ord Herb
Herb -> Herb -> Bool
Herb -> Herb -> Ordering
Herb -> Herb -> Herb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Herb -> Herb -> Ordering
compare :: Herb -> Herb -> Ordering
$c< :: Herb -> Herb -> Bool
< :: Herb -> Herb -> Bool
$c<= :: Herb -> Herb -> Bool
<= :: Herb -> Herb -> Bool
$c> :: Herb -> Herb -> Bool
> :: Herb -> Herb -> Bool
$c>= :: Herb -> Herb -> Bool
>= :: Herb -> Herb -> Bool
$cmax :: Herb -> Herb -> Herb
max :: Herb -> Herb -> Herb
$cmin :: Herb -> Herb -> Herb
min :: Herb -> Herb -> Herb
Ord, (forall x. Herb -> Rep Herb x)
-> (forall x. Rep Herb x -> Herb) -> Generic Herb
forall x. Rep Herb x -> Herb
forall x. Herb -> Rep Herb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Herb -> Rep Herb x
from :: forall x. Herb -> Rep Herb x
$cto :: forall x. Rep Herb x -> Herb
to :: forall x. Rep Herb x -> Herb
Generic)

-- | Can the character be used in unquoted identifiers?
isUnquotedIdentChar :: Char -> Bool
isUnquotedIdentChar :: Char -> Bool
isUnquotedIdentChar Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'(', Char
')', Char
'\'', Char
'\\'])

-- | Should this character be escaped in quoted identifiers?
isEscapable :: Char -> Bool
isEscapable :: Char -> Bool
isEscapable Char
c = (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')

-- | Helper for escaping the atoms for Herb.
--
-- >>> escAtom "hello"
-- "hello"
-- >>> escAtom "hello!"
-- "hello!"
-- >>> escAtom "hello world"
-- "'hello world'"
-- >>> escAtom "''\\''"
-- "'\\'\\'\\\\\\'\\''"
escAtom :: T.Text -> T.Text
escAtom :: Ident -> Ident
escAtom Ident
x
  | Ident -> Bool
T.null Ident
x = Ident -> Ident
quote Ident
x
  | (Char -> Bool) -> Ident -> Bool
T.all Char -> Bool
isUnquotedIdentChar Ident
x = Ident
x
  | Bool
otherwise = Ident -> Ident
quote Ident
x

quote :: T.Text -> T.Text
quote :: Ident -> Ident
quote Ident
x = Char -> Ident
T.singleton Char
'\'' Ident -> Ident -> Ident
forall a. Semigroup a => a -> a -> a
<> (Char -> Ident) -> Ident -> Ident
T.concatMap Char -> Ident
escape Ident
x Ident -> Ident -> Ident
forall a. Semigroup a => a -> a -> a
<> Char -> Ident
T.singleton Char
'\''

escape :: Char -> T.Text
escape :: Char -> Ident
escape Char
c
  | Char -> Bool
isEscapable Char
c = Char -> Ident
T.singleton Char
'\\' Ident -> Ident -> Ident
forall a. Semigroup a => a -> a -> a
<> Char -> Ident
T.singleton Char
c
  | Bool
otherwise = Char -> Ident
T.singleton Char
c

-- | Serialize a `Herb` structure as `T.Text`. The output can be parsed by
-- `Data.Herb.Parser.parseHerb`.
formatHerb :: Herb -> T.Text
formatHerb :: Herb -> Ident
formatHerb (Atom Ident
a) = Ident -> Ident
escAtom Ident
a
formatHerb (Struct Ident
h [Herb]
ps) =
  [Ident] -> Ident
T.concat
    [ Ident -> Ident
escAtom Ident
h
    , Char -> Ident
T.singleton Char
'('
    , Ident -> [Ident] -> Ident
T.intercalate (Char -> Ident
T.singleton Char
',') ((Herb -> Ident) -> [Herb] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map Herb -> Ident
formatHerb [Herb]
ps)
    , Char -> Ident
T.singleton Char
')'
    ]

-- | Shortcut for directly producing a serializable string from the data.
--
-- Equivalent to @formatHerb . toHerb@.
encodeHerb :: ToHerb a => a -> T.Text
encodeHerb :: forall a. ToHerb a => a -> Ident
encodeHerb = Herb -> Ident
formatHerb (Herb -> Ident) -> (a -> Herb) -> a -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Herb
forall a. ToHerb a => a -> Herb
toHerb

-- | Class of everything that can be converted to `Herb`. Can be derived from
-- `Generic`.
class ToHerb a where
  -- | Convert @a@ to `Herb`.
  toHerb :: a -> Herb
  default toHerb :: (Generic a, GToHerb a (Rep a) Herb) => a -> Herb
  toHerb = GToHerbParam a -> Rep a a -> Herb
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb (GToHerbParam a
forall a. GToHerbParam a
GToHerbNoArg :: GToHerbParam a) (Rep a a -> Herb) -> (a -> Rep a a) -> a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a a
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

-- | Class of single-parameter constructors that can be converted to `Herb`.
-- Can be derived from `Generic1`.
class ToHerb1 f where
  -- | Convert the @f a@ to `Herb`, provided there is a function to convert the
  -- @a@ to Herb.
  liftToHerb :: (a -> Herb) -> f a -> Herb
  default liftToHerb :: (Generic1 f, GToHerb a (Rep1 f) Herb) =>
    (a -> Herb) -> f a -> Herb
  liftToHerb a -> Herb
p = GToHerbParam a -> Rep1 f a -> Herb
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb ((a -> Herb) -> GToHerbParam a
forall a. (a -> Herb) -> GToHerbParam a
GToHerbOneArg a -> Herb
p) (Rep1 f a -> Herb) -> (f a -> Rep1 f a) -> f a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

data GToHerbParam a
  = GToHerbNoArg
  | GToHerbOneArg (a -> Herb)

class GToHerb a rep out where
  gToHerb :: GToHerbParam a -> rep a -> out

instance GToHerb p U1 [Herb] where
  gToHerb :: GToHerbParam p -> U1 p -> [Herb]
gToHerb GToHerbParam p
_ = [Herb] -> U1 p -> [Herb]
forall a b. a -> b -> a
const []

instance ToHerb a => GToHerb p (K1 i a) [Herb] where
  gToHerb :: GToHerbParam p -> K1 i a p -> [Herb]
gToHerb GToHerbParam p
_ = Herb -> [Herb]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Herb -> [Herb]) -> (K1 i a p -> Herb) -> K1 i a p -> [Herb]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Herb
forall a. ToHerb a => a -> Herb
toHerb (a -> Herb) -> (K1 i a p -> a) -> K1 i a p -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a p -> a
forall k i c (p :: k). K1 i c p -> c
unK1

instance (GToHerb p a [xs], GToHerb p b [xs]) => GToHerb p (a :*: b) [xs] where
  gToHerb :: GToHerbParam p -> (:*:) a b p -> [xs]
gToHerb GToHerbParam p
p (a p
l :*: b p
r) = GToHerbParam p -> a p -> [xs]
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p a p
l [xs] -> [xs] -> [xs]
forall a. [a] -> [a] -> [a]
++ GToHerbParam p -> b p -> [xs]
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p b p
r

instance (GToHerb p a x, GToHerb p b x) => GToHerb p (a :+: b) x where
  gToHerb :: GToHerbParam p -> (:+:) a b p -> x
gToHerb GToHerbParam p
p (L1 a p
a) = GToHerbParam p -> a p -> x
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p a p
a
  gToHerb GToHerbParam p
p (R1 b p
a) = GToHerbParam p -> b p -> x
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p b p
a

instance GToHerb p a Herb => GToHerb p (D1 c a) Herb where
  gToHerb :: GToHerbParam p -> D1 c a p -> Herb
gToHerb GToHerbParam p
p = GToHerbParam p -> a p -> Herb
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p (a p -> Herb) -> (D1 c a p -> a p) -> D1 c a p -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 c a p -> a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance (GToHerb p a [Herb], Constructor c) => GToHerb p (C1 c a) Herb where
  gToHerb :: GToHerbParam p -> C1 c a p -> Herb
gToHerb GToHerbParam p
p =
    Ident -> [Herb] -> Herb
Struct (String -> Ident
packIdent (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ M1 C c a Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName (C1 c a x
forall {x}. C1 c a x
forall a. HasCallStack => a
undefined :: C1 c a x)) ([Herb] -> Herb) -> (C1 c a p -> [Herb]) -> C1 c a p -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GToHerbParam p -> a p -> [Herb]
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p (a p -> [Herb]) -> (C1 c a p -> a p) -> C1 c a p -> [Herb]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a p -> a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance GToHerb p a x => GToHerb p (S1 c a) x where
  gToHerb :: GToHerbParam p -> S1 c a p -> x
gToHerb GToHerbParam p
p = GToHerbParam p -> a p -> x
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam p
p (a p -> x) -> (S1 c a p -> a p) -> S1 c a p -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 c a p -> a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance GToHerb a Par1 Herb where
  gToHerb :: GToHerbParam a -> Par1 a -> Herb
gToHerb (GToHerbOneArg a -> Herb
p) = a -> Herb
p (a -> Herb) -> (Par1 a -> a) -> Par1 a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par1 a -> a
forall p. Par1 p -> p
unPar1
  gToHerb GToHerbParam a
_ = String -> Par1 a -> Herb
forall a. HasCallStack => String -> a
error String
"GToHerb Par1"

instance GToHerb a Par1 [Herb] where
  gToHerb :: GToHerbParam a -> Par1 a -> [Herb]
gToHerb GToHerbParam a
p = Herb -> [Herb]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Herb -> [Herb]) -> (Par1 a -> Herb) -> Par1 a -> [Herb]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GToHerbParam a -> Par1 a -> Herb
forall a (rep :: * -> *) out.
GToHerb a rep out =>
GToHerbParam a -> rep a -> out
gToHerb GToHerbParam a
p

instance ToHerb1 f => GToHerb a (Rec1 f) Herb where
  gToHerb :: GToHerbParam a -> Rec1 f a -> Herb
gToHerb (GToHerbOneArg a -> Herb
p) = (a -> Herb) -> f a -> Herb
forall a. (a -> Herb) -> f a -> Herb
forall (f :: * -> *) a. ToHerb1 f => (a -> Herb) -> f a -> Herb
liftToHerb a -> Herb
p (f a -> Herb) -> (Rec1 f a -> f a) -> Rec1 f a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
  gToHerb GToHerbParam a
_ = String -> Rec1 f a -> Herb
forall a. HasCallStack => String -> a
error String
"GToHerb Rec1"

-- | Parser for `Herb`-like objects of type @h@ into @a@. Used in `FromHerb`.
newtype Parser h a = Parser
  { forall h a. Parser h a -> h -> Either String (h, a)
runParser :: h -> (Either String (h, a)) -- ^ Either parse @h@ into @a@ and potential leftovers, or fail with `String` error.
  }

instance Functor (Parser h) where
  fmap :: forall a b. (a -> b) -> Parser h a -> Parser h b
fmap a -> b
f Parser h a
p = (h -> Either String (h, b)) -> Parser h b
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, b)) -> Parser h b)
-> (h -> Either String (h, b)) -> Parser h b
forall a b. (a -> b) -> a -> b
$ ((h, a) -> (h, b)) -> Either String (h, a) -> Either String (h, b)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (h, a) -> (h, b)
forall a b. (a -> b) -> (h, a) -> (h, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Either String (h, a) -> Either String (h, b))
-> (h -> Either String (h, a)) -> h -> Either String (h, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser h a -> h -> Either String (h, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h a
p

instance Applicative (Parser h) where
  pure :: forall a. a -> Parser h a
pure a
a = (h -> Either String (h, a)) -> Parser h a
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, a)) -> Parser h a)
-> (h -> Either String (h, a)) -> Parser h a
forall a b. (a -> b) -> a -> b
$ \h
h -> (h, a) -> Either String (h, a)
forall a b. b -> Either a b
Right (h
h, a
a)
  Parser h (a -> b)
p1 <*> :: forall a b. Parser h (a -> b) -> Parser h a -> Parser h b
<*> Parser h a
p2 =
    (h -> Either String (h, b)) -> Parser h b
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, b)) -> Parser h b)
-> (h -> Either String (h, b)) -> Parser h b
forall a b. (a -> b) -> a -> b
$ \h
h ->
      case Parser h (a -> b) -> h -> Either String (h, a -> b)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h (a -> b)
p1 h
h of
        Right (h
h', a -> b
f) ->
          case Parser h a -> h -> Either String (h, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h a
p2 h
h' of
            Right (h
h'', a
a) -> (h, b) -> Either String (h, b)
forall a b. b -> Either a b
Right (h
h'', a -> b
f a
a)
            Left String
e -> String -> Either String (h, b)
forall a b. a -> Either a b
Left String
e
        Left String
e -> String -> Either String (h, b)
forall a b. a -> Either a b
Left String
e

instance Monad (Parser h) where
  return :: forall a. a -> Parser h a
return = a -> Parser h a
forall a. a -> Parser h a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Parser h a
p1 >>= :: forall a b. Parser h a -> (a -> Parser h b) -> Parser h b
>>= a -> Parser h b
f =
    (h -> Either String (h, b)) -> Parser h b
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, b)) -> Parser h b)
-> (h -> Either String (h, b)) -> Parser h b
forall a b. (a -> b) -> a -> b
$ \h
h ->
      case Parser h a -> h -> Either String (h, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h a
p1 h
h of
        Right (h
h', a
a) -> Parser h b -> h -> Either String (h, b)
forall h a. Parser h a -> h -> Either String (h, a)
runParser (a -> Parser h b
f a
a) h
h'
        Left String
e -> String -> Either String (h, b)
forall a b. a -> Either a b
Left String
e

instance MonadFail (Parser h) where
  fail :: forall a. String -> Parser h a
fail = (h -> Either String (h, a)) -> Parser h a
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, a)) -> Parser h a)
-> (String -> h -> Either String (h, a)) -> String -> Parser h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (h, a) -> h -> Either String (h, a)
forall a b. a -> b -> a
const (Either String (h, a) -> h -> Either String (h, a))
-> (String -> Either String (h, a))
-> String
-> h
-> Either String (h, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (h, a)
forall a b. a -> Either a b
Left

instance MonadPlus (Parser h) where
  mzero :: forall a. Parser h a
mzero = String -> Parser h a
forall a. String -> Parser h a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
  mplus :: forall a. Parser h a -> Parser h a -> Parser h a
mplus Parser h a
p1 Parser h a
p2 =
    (h -> Either String (h, a)) -> Parser h a
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, a)) -> Parser h a)
-> (h -> Either String (h, a)) -> Parser h a
forall a b. (a -> b) -> a -> b
$ \h
h ->
      case Parser h a -> h -> Either String (h, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h a
p1 h
h of
        Right (h
h', a
f) -> (h, a) -> Either String (h, a)
forall a b. b -> Either a b
Right (h
h', a
f)
        Left String
_ -> Parser h a -> h -> Either String (h, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser h a
p2 h
h

instance Alternative (Parser h) where
  empty :: forall a. Parser h a
empty = Parser h a
forall a. Parser h a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. Parser h a -> Parser h a -> Parser h a
(<|>) = Parser h a -> Parser h a -> Parser h a
forall a. Parser h a -> Parser h a -> Parser h a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Semigroup (Parser h a) where
  <> :: Parser h a -> Parser h a -> Parser h a
(<>) = Parser h a -> Parser h a -> Parser h a
forall a. Parser h a -> Parser h a -> Parser h a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monoid (Parser h a) where
  mempty :: Parser h a
mempty = String -> Parser h a
forall a. String -> Parser h a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"

-- | Class of everything that can be parsed from `Herb` structure. If
-- available, the method defaults from `Generic` instance for @a@.
-- The simplest way to use the class is via `fromHerb`.
class FromHerb a where
  parseHerb :: Parser Herb a
                             -- ^ Parse `Herb` to a type @a@.
  default parseHerb :: (Generic a, GFromHerb (Const ()) Herb (Rep a)) =>
    Parser Herb a
  parseHerb = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Parser Herb (Rep a Any) -> Parser Herb a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Const () Any -> Parser Herb (Rep a Any)
forall x. Const () x -> Parser Herb (Rep a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb (() -> Const () Any
forall {k} a (b :: k). a -> Const a b
Const ())

-- | Class of single-parameter constructors that can be parsed from `Herb`.
-- Can be derived from `Generic1`.
class FromHerb1 f where
  -- | Given a parser for the contained type @a@, parse @f a@.
  liftParseHerb :: Parser Herb a -> Parser Herb (f a)
  default liftParseHerb :: (Generic1 f, GFromHerb (Parser Herb) Herb (Rep1 f)) =>
    Parser Herb a -> Parser Herb (f a)
  liftParseHerb Parser Herb a
p = Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f a -> f a) -> Parser Herb (Rep1 f a) -> Parser Herb (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb a -> Parser Herb (Rep1 f a)
forall x. Parser Herb x -> Parser Herb (Rep1 f x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb Parser Herb a
p

-- | Simple front-end for `FromHerb`'s `parseHerb`.
fromHerb :: FromHerb a => Herb -> Either String a
fromHerb :: forall a. FromHerb a => Herb -> Either String a
fromHerb Herb
h =
  case Parser Herb a -> Herb -> Either String (Herb, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb Herb
h of
    Left String
e -> String -> Either String a
forall a b. a -> Either a b
Left String
e
    Right (Herb
_, a
a) -> a -> Either String a
forall a b. b -> Either a b
Right a
a

class GFromHerb p i a where
  gParseHerb :: p x -> Parser i (a x)

instance GFromHerb p Herb U1 where
  gParseHerb :: forall x. p x -> Parser Herb (U1 x)
gParseHerb p x
_ = U1 x -> Parser Herb (U1 x)
forall a. a -> Parser Herb a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 x
forall k (p :: k). U1 p
U1

instance GFromHerb p [Herb] U1 where
  gParseHerb :: forall x. p x -> Parser [Herb] (U1 x)
gParseHerb = Parser Herb (U1 x) -> Parser [Herb] (U1 x)
forall a. Parser Herb a -> Parser [Herb] a
parseArg (Parser Herb (U1 x) -> Parser [Herb] (U1 x))
-> (p x -> Parser Herb (U1 x)) -> p x -> Parser [Herb] (U1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p x -> Parser Herb (U1 x)
forall x. p x -> Parser Herb (U1 x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb

instance FromHerb a => GFromHerb p Herb (K1 i a) where
  gParseHerb :: forall x. p x -> Parser Herb (K1 i a x)
gParseHerb p x
_ = a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a x) -> Parser Herb a -> Parser Herb (K1 i a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb

instance GFromHerb p Herb (K1 i a) => GFromHerb p [Herb] (K1 i a) where
  gParseHerb :: forall x. p x -> Parser [Herb] (K1 i a x)
gParseHerb = Parser Herb (K1 i a x) -> Parser [Herb] (K1 i a x)
forall a. Parser Herb a -> Parser [Herb] a
parseArg (Parser Herb (K1 i a x) -> Parser [Herb] (K1 i a x))
-> (p x -> Parser Herb (K1 i a x))
-> p x
-> Parser [Herb] (K1 i a x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p x -> Parser Herb (K1 i a x)
forall x. p x -> Parser Herb (K1 i a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb

instance (GFromHerb p [Herb] a, GFromHerb p [Herb] b) =>
         GFromHerb p [Herb] (a :*: b) where
  gParseHerb :: forall x. p x -> Parser [Herb] ((:*:) a b x)
gParseHerb p x
p = a x -> b x -> (:*:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a x -> b x -> (:*:) a b x)
-> Parser [Herb] (a x) -> Parser [Herb] (b x -> (:*:) a b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p x -> Parser [Herb] (a x)
forall x. p x -> Parser [Herb] (a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p Parser [Herb] (b x -> (:*:) a b x)
-> Parser [Herb] (b x) -> Parser [Herb] ((:*:) a b x)
forall a b.
Parser [Herb] (a -> b) -> Parser [Herb] a -> Parser [Herb] b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p x -> Parser [Herb] (b x)
forall x. p x -> Parser [Herb] (b x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p

instance (GFromHerb p Herb a, GFromHerb p Herb b) => GFromHerb p Herb (a :+: b) where
  gParseHerb :: forall x. p x -> Parser Herb ((:+:) a b x)
gParseHerb p x
p = a x -> (:+:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a x -> (:+:) a b x)
-> Parser Herb (a x) -> Parser Herb ((:+:) a b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p x -> Parser Herb (a x)
forall x. p x -> Parser Herb (a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p Parser Herb ((:+:) a b x)
-> Parser Herb ((:+:) a b x) -> Parser Herb ((:+:) a b x)
forall a. Parser Herb a -> Parser Herb a -> Parser Herb a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b x -> (:+:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b x -> (:+:) a b x)
-> Parser Herb (b x) -> Parser Herb ((:+:) a b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p x -> Parser Herb (b x)
forall x. p x -> Parser Herb (b x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p

instance GFromHerb p Herb a => GFromHerb p Herb (D1 c a) where
  gParseHerb :: forall x. p x -> Parser Herb (D1 c a x)
gParseHerb p x
p = a x -> M1 D c a x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a x -> M1 D c a x)
-> Parser Herb (a x) -> Parser Herb (M1 D c a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p x -> Parser Herb (a x)
forall x. p x -> Parser Herb (a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p

instance (GFromHerb p [Herb] a, Constructor c) => GFromHerb p Herb (C1 c a) where
  gParseHerb :: forall x. p x -> Parser Herb (C1 c a x)
gParseHerb p x
p =
    a x -> M1 C c a x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1
      (a x -> M1 C c a x)
-> Parser Herb (a x) -> Parser Herb (M1 C c a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Parser [Herb] (a x) -> Parser Herb (a x)
forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct
            (String -> Ident
packIdent (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ M1 C c a Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName (C1 c a x
forall {x}. C1 c a x
forall a. HasCallStack => a
undefined :: C1 c a x))
            (p x -> Parser [Herb] (a x)
forall x. p x -> Parser [Herb] (a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p Parser [Herb] (a x) -> Parser [Herb] () -> Parser [Herb] (a x)
forall a b. Parser [Herb] a -> Parser [Herb] b -> Parser [Herb] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Herb] ()
forall h. Parser [h] ()
endOfArgs)

instance GFromHerb p h a => GFromHerb p h (S1 c a) where
  gParseHerb :: forall x. p x -> Parser h (S1 c a x)
gParseHerb p x
p = a x -> M1 S c a x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a x -> M1 S c a x) -> Parser h (a x) -> Parser h (M1 S c a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p x -> Parser h (a x)
forall x. p x -> Parser h (a x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb p x
p

instance GFromHerb (Parser Herb) Herb Par1 where
  gParseHerb :: forall x. Parser Herb x -> Parser Herb (Par1 x)
gParseHerb Parser Herb x
p = x -> Par1 x
forall p. p -> Par1 p
Par1 (x -> Par1 x) -> Parser Herb x -> Parser Herb (Par1 x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb x
p

instance GFromHerb (Parser Herb) [Herb] Par1 where
  gParseHerb :: forall x. Parser Herb x -> Parser [Herb] (Par1 x)
gParseHerb = Parser Herb (Par1 x) -> Parser [Herb] (Par1 x)
forall a. Parser Herb a -> Parser [Herb] a
parseArg (Parser Herb (Par1 x) -> Parser [Herb] (Par1 x))
-> (Parser Herb x -> Parser Herb (Par1 x))
-> Parser Herb x
-> Parser [Herb] (Par1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Herb x -> Parser Herb (Par1 x)
forall x. Parser Herb x -> Parser Herb (Par1 x)
forall (p :: * -> *) i (a :: * -> *) x.
GFromHerb p i a =>
p x -> Parser i (a x)
gParseHerb

instance FromHerb1 f => GFromHerb (Parser Herb) Herb (Rec1 f) where
  gParseHerb :: forall x. Parser Herb x -> Parser Herb (Rec1 f x)
gParseHerb Parser Herb x
p = f x -> Rec1 f x
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f x -> Rec1 f x) -> Parser Herb (f x) -> Parser Herb (Rec1 f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb x -> Parser Herb (f x)
forall a. Parser Herb a -> Parser Herb (f a)
forall (f :: * -> *) a.
FromHerb1 f =>
Parser Herb a -> Parser Herb (f a)
liftParseHerb Parser Herb x
p

-- | Newtype wrapper for deriving simple atom-only instances for `ToHerb` and
-- `FromHerb` from existing `Show` and `Read` (respectively) for serialization.
--
-- >>> toHerb $ ShowAtom [LT .. GT]
-- Atom "[LT,EQ,GT]"
-- >>> getShowAtom <$> fromHerb (Atom "[LT,EQ,GT]") :: Either String [Ordering]
-- Right [LT,EQ,GT]
-- >>> deriving via ShowAtom Integer instance ToHerb Integer
-- >>> toHerb (5::Integer)
-- Atom "5"
newtype ShowAtom a = ShowAtom
  { forall a. ShowAtom a -> a
getShowAtom :: a
  } deriving (Int -> ShowAtom a -> ShowS
[ShowAtom a] -> ShowS
ShowAtom a -> String
(Int -> ShowAtom a -> ShowS)
-> (ShowAtom a -> String)
-> ([ShowAtom a] -> ShowS)
-> Show (ShowAtom a)
forall a. Show a => Int -> ShowAtom a -> ShowS
forall a. Show a => [ShowAtom a] -> ShowS
forall a. Show a => ShowAtom a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ShowAtom a -> ShowS
showsPrec :: Int -> ShowAtom a -> ShowS
$cshow :: forall a. Show a => ShowAtom a -> String
show :: ShowAtom a -> String
$cshowList :: forall a. Show a => [ShowAtom a] -> ShowS
showList :: [ShowAtom a] -> ShowS
Show, ReadPrec [ShowAtom a]
ReadPrec (ShowAtom a)
Int -> ReadS (ShowAtom a)
ReadS [ShowAtom a]
(Int -> ReadS (ShowAtom a))
-> ReadS [ShowAtom a]
-> ReadPrec (ShowAtom a)
-> ReadPrec [ShowAtom a]
-> Read (ShowAtom a)
forall a. Read a => ReadPrec [ShowAtom a]
forall a. Read a => ReadPrec (ShowAtom a)
forall a. Read a => Int -> ReadS (ShowAtom a)
forall a. Read a => ReadS [ShowAtom a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ShowAtom a)
readsPrec :: Int -> ReadS (ShowAtom a)
$creadList :: forall a. Read a => ReadS [ShowAtom a]
readList :: ReadS [ShowAtom a]
$creadPrec :: forall a. Read a => ReadPrec (ShowAtom a)
readPrec :: ReadPrec (ShowAtom a)
$creadListPrec :: forall a. Read a => ReadPrec [ShowAtom a]
readListPrec :: ReadPrec [ShowAtom a]
Read, ShowAtom a -> ShowAtom a -> Bool
(ShowAtom a -> ShowAtom a -> Bool)
-> (ShowAtom a -> ShowAtom a -> Bool) -> Eq (ShowAtom a)
forall a. Eq a => ShowAtom a -> ShowAtom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ShowAtom a -> ShowAtom a -> Bool
== :: ShowAtom a -> ShowAtom a -> Bool
$c/= :: forall a. Eq a => ShowAtom a -> ShowAtom a -> Bool
/= :: ShowAtom a -> ShowAtom a -> Bool
Eq, Eq (ShowAtom a)
Eq (ShowAtom a) =>
(ShowAtom a -> ShowAtom a -> Ordering)
-> (ShowAtom a -> ShowAtom a -> Bool)
-> (ShowAtom a -> ShowAtom a -> Bool)
-> (ShowAtom a -> ShowAtom a -> Bool)
-> (ShowAtom a -> ShowAtom a -> Bool)
-> (ShowAtom a -> ShowAtom a -> ShowAtom a)
-> (ShowAtom a -> ShowAtom a -> ShowAtom a)
-> Ord (ShowAtom a)
ShowAtom a -> ShowAtom a -> Bool
ShowAtom a -> ShowAtom a -> Ordering
ShowAtom a -> ShowAtom a -> ShowAtom a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ShowAtom a)
forall a. Ord a => ShowAtom a -> ShowAtom a -> Bool
forall a. Ord a => ShowAtom a -> ShowAtom a -> Ordering
forall a. Ord a => ShowAtom a -> ShowAtom a -> ShowAtom a
$ccompare :: forall a. Ord a => ShowAtom a -> ShowAtom a -> Ordering
compare :: ShowAtom a -> ShowAtom a -> Ordering
$c< :: forall a. Ord a => ShowAtom a -> ShowAtom a -> Bool
< :: ShowAtom a -> ShowAtom a -> Bool
$c<= :: forall a. Ord a => ShowAtom a -> ShowAtom a -> Bool
<= :: ShowAtom a -> ShowAtom a -> Bool
$c> :: forall a. Ord a => ShowAtom a -> ShowAtom a -> Bool
> :: ShowAtom a -> ShowAtom a -> Bool
$c>= :: forall a. Ord a => ShowAtom a -> ShowAtom a -> Bool
>= :: ShowAtom a -> ShowAtom a -> Bool
$cmax :: forall a. Ord a => ShowAtom a -> ShowAtom a -> ShowAtom a
max :: ShowAtom a -> ShowAtom a -> ShowAtom a
$cmin :: forall a. Ord a => ShowAtom a -> ShowAtom a -> ShowAtom a
min :: ShowAtom a -> ShowAtom a -> ShowAtom a
Ord)

instance Show a => ToHerb (ShowAtom a) where
  toHerb :: ShowAtom a -> Herb
toHerb = a -> Herb
forall a. Show a => a -> Herb
atomShow (a -> Herb) -> (ShowAtom a -> a) -> ShowAtom a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowAtom a -> a
forall a. ShowAtom a -> a
getShowAtom

instance Read a => FromHerb (ShowAtom a) where
  parseHerb :: Parser Herb (ShowAtom a)
parseHerb = a -> ShowAtom a
forall a. a -> ShowAtom a
ShowAtom (a -> ShowAtom a) -> Parser Herb a -> Parser Herb (ShowAtom a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb a
forall a. Read a => Parser Herb a
atomRead

-- | Newtype wrapper for parsing out "plain Herb", without actually converting
-- it to another datatype via `FromHerb`.
--
-- >>> getPlainHerb <$> decodeHerb "foo(bar,qux)"
-- Right (Struct "foo" [Atom "bar",Atom "qux"])
newtype PlainHerb = PlainHerb
  { PlainHerb -> Herb
getPlainHerb :: Herb
  } deriving (Int -> PlainHerb -> ShowS
[PlainHerb] -> ShowS
PlainHerb -> String
(Int -> PlainHerb -> ShowS)
-> (PlainHerb -> String)
-> ([PlainHerb] -> ShowS)
-> Show PlainHerb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlainHerb -> ShowS
showsPrec :: Int -> PlainHerb -> ShowS
$cshow :: PlainHerb -> String
show :: PlainHerb -> String
$cshowList :: [PlainHerb] -> ShowS
showList :: [PlainHerb] -> ShowS
Show, ReadPrec [PlainHerb]
ReadPrec PlainHerb
Int -> ReadS PlainHerb
ReadS [PlainHerb]
(Int -> ReadS PlainHerb)
-> ReadS [PlainHerb]
-> ReadPrec PlainHerb
-> ReadPrec [PlainHerb]
-> Read PlainHerb
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PlainHerb
readsPrec :: Int -> ReadS PlainHerb
$creadList :: ReadS [PlainHerb]
readList :: ReadS [PlainHerb]
$creadPrec :: ReadPrec PlainHerb
readPrec :: ReadPrec PlainHerb
$creadListPrec :: ReadPrec [PlainHerb]
readListPrec :: ReadPrec [PlainHerb]
Read, PlainHerb -> PlainHerb -> Bool
(PlainHerb -> PlainHerb -> Bool)
-> (PlainHerb -> PlainHerb -> Bool) -> Eq PlainHerb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlainHerb -> PlainHerb -> Bool
== :: PlainHerb -> PlainHerb -> Bool
$c/= :: PlainHerb -> PlainHerb -> Bool
/= :: PlainHerb -> PlainHerb -> Bool
Eq, Eq PlainHerb
Eq PlainHerb =>
(PlainHerb -> PlainHerb -> Ordering)
-> (PlainHerb -> PlainHerb -> Bool)
-> (PlainHerb -> PlainHerb -> Bool)
-> (PlainHerb -> PlainHerb -> Bool)
-> (PlainHerb -> PlainHerb -> Bool)
-> (PlainHerb -> PlainHerb -> PlainHerb)
-> (PlainHerb -> PlainHerb -> PlainHerb)
-> Ord PlainHerb
PlainHerb -> PlainHerb -> Bool
PlainHerb -> PlainHerb -> Ordering
PlainHerb -> PlainHerb -> PlainHerb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PlainHerb -> PlainHerb -> Ordering
compare :: PlainHerb -> PlainHerb -> Ordering
$c< :: PlainHerb -> PlainHerb -> Bool
< :: PlainHerb -> PlainHerb -> Bool
$c<= :: PlainHerb -> PlainHerb -> Bool
<= :: PlainHerb -> PlainHerb -> Bool
$c> :: PlainHerb -> PlainHerb -> Bool
> :: PlainHerb -> PlainHerb -> Bool
$c>= :: PlainHerb -> PlainHerb -> Bool
>= :: PlainHerb -> PlainHerb -> Bool
$cmax :: PlainHerb -> PlainHerb -> PlainHerb
max :: PlainHerb -> PlainHerb -> PlainHerb
$cmin :: PlainHerb -> PlainHerb -> PlainHerb
min :: PlainHerb -> PlainHerb -> PlainHerb
Ord)

-- | Trivial instance that just returns the incoming `Herb` wrapped in
-- t`PlainHerb`.
instance FromHerb PlainHerb where
  parseHerb :: Parser Herb PlainHerb
parseHerb = (Herb -> Either String (Herb, PlainHerb)) -> Parser Herb PlainHerb
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((Herb -> Either String (Herb, PlainHerb))
 -> Parser Herb PlainHerb)
-> (Herb -> Either String (Herb, PlainHerb))
-> Parser Herb PlainHerb
forall a b. (a -> b) -> a -> b
$ \Herb
h -> (Herb, PlainHerb) -> Either String (Herb, PlainHerb)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Herb
h, Herb -> PlainHerb
PlainHerb Herb
h)

-- | Return the current parser input as processed by a given function.
gets :: (h -> a) -> Parser h a
gets :: forall h a. (h -> a) -> Parser h a
gets h -> a
f = (h -> Either String (h, a)) -> Parser h a
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, a)) -> Parser h a)
-> (h -> Either String (h, a)) -> Parser h a
forall a b. (a -> b) -> a -> b
$ \h
h -> (h, a) -> Either String (h, a)
forall a b. b -> Either a b
Right (h
h, h -> a
f h
h)

-- | Return the current parser input (identical to @gets id@).
get :: Parser h h
get :: forall h. Parser h h
get = (h -> h) -> Parser h h
forall h a. (h -> a) -> Parser h a
gets h -> h
forall a. a -> a
id

-- | Set the current parser input.
put :: h -> Parser h ()
put :: forall h. h -> Parser h ()
put = (h -> h) -> Parser h ()
forall h. (h -> h) -> Parser h ()
modify ((h -> h) -> Parser h ()) -> (h -> h -> h) -> h -> Parser h ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> h -> h
forall a b. a -> b -> a
const

-- | Change the current parser using a function.
modify :: (h -> h) -> Parser h ()
modify :: forall h. (h -> h) -> Parser h ()
modify h -> h
f = (h -> Either String (h, ())) -> Parser h ()
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, ())) -> Parser h ())
-> (h -> Either String (h, ())) -> Parser h ()
forall a b. (a -> b) -> a -> b
$ \h
h -> (h, ()) -> Either String (h, ())
forall a b. b -> Either a b
Right (h -> h
f h
h, ())

-- | Run a parser with temporarily changed input specified by @l@.
local :: l -> Parser l a -> Parser h a
local :: forall l a h. l -> Parser l a -> Parser h a
local l
l Parser l a
p =
  (h -> Either String (h, a)) -> Parser h a
forall h a. (h -> Either String (h, a)) -> Parser h a
Parser ((h -> Either String (h, a)) -> Parser h a)
-> (h -> Either String (h, a)) -> Parser h a
forall a b. (a -> b) -> a -> b
$ \h
h ->
    case Parser l a -> l -> Either String (l, a)
forall h a. Parser h a -> h -> Either String (h, a)
runParser Parser l a
p l
l of
      Right (l
_, a
a) -> (h, a) -> Either String (h, a)
forall a b. b -> Either a b
Right (h
h, a
a)
      Left String
e -> String -> Either String (h, a)
forall a b. a -> Either a b
Left String
e

-- | Run a parser with temporarily changed input, created from the current
-- input using the first parameter.
contexted :: (h -> l) -> Parser l a -> Parser h a
contexted :: forall h l a. (h -> l) -> Parser l a -> Parser h a
contexted h -> l
f Parser l a
p = do
  h <- Parser h h
forall h. Parser h h
get
  local (f h) p

-- | Parse out an `Atom` where the identifier satisfies a predicate.
satisfyAtom :: (Ident -> Bool) -> Parser Herb Ident
satisfyAtom :: (Ident -> Bool) -> Parser Herb Ident
satisfyAtom Ident -> Bool
p = do
  Atom x <- Parser Herb Herb
forall h. Parser h h
get
  if p x
    then pure x
    else fail "satisfyAtom"

-- | Parse out an `Atom` with an exact identifier.
exactAtom :: Ident -> Parser Herb Ident
exactAtom :: Ident -> Parser Herb Ident
exactAtom = (Ident -> Bool) -> Parser Herb Ident
satisfyAtom ((Ident -> Bool) -> Parser Herb Ident)
-> (Ident -> Ident -> Bool) -> Ident -> Parser Herb Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Convert @a@ to an `Atom` using its `Show` instance.
--
-- >>> atomShow (123::Int)
-- Atom "123"
atomShow :: Show a => a -> Herb
atomShow :: forall a. Show a => a -> Herb
atomShow = Ident -> Herb
Atom (Ident -> Herb) -> (a -> Ident) -> a -> Herb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ident
packIdent (String -> Ident) -> (a -> String) -> a -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Parse an `Atom` to @a@ using its @Read@ instance.
-- Produces a parser failure if the atom's identifier can not be read.
--
-- > atomRead :: Parser Herb Int
atomRead :: Read a => Parser Herb a
atomRead :: forall a. Read a => Parser Herb a
atomRead = (Ident -> Maybe a) -> Parser Herb a
forall a. (Ident -> Maybe a) -> Parser Herb a
maybeAtom (String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Ident -> String) -> Ident -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> String
unpackIdent)

-- | Parse out an `Atom` if the given function converts the identifier to @Just
-- x@, and return the @x@.
maybeAtom :: (Ident -> Maybe a) -> Parser Herb a
maybeAtom :: forall a. (Ident -> Maybe a) -> Parser Herb a
maybeAtom Ident -> Maybe a
f = do
  Atom x <- Parser Herb Herb
forall h. Parser h h
get
  case f x of
    Just a
y -> a -> Parser Herb a
forall a. a -> Parser Herb a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y
    Maybe a
_ -> String -> Parser Herb a
forall a. String -> Parser Herb a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"maybeAtom"

-- | Parse out a structure identified by an exact name. The second argument is
-- a parser for the structure arguments that works on the argument list;
-- individual arguments can be obtained via `popArg` and related functions.
--
-- > exactStruct "pair" $ (,) <$> popArg' <*> popArg' <* endOfArgs
-- >   :: (FromHerb a1, FromHerb a2) => Parser Herb (a1, a2)
exactStruct :: Ident -> Parser [Herb] a -> Parser Herb a
exactStruct :: forall a. Ident -> Parser [Herb] a -> Parser Herb a
exactStruct Ident
s Parser [Herb] a
p = do
  Struct h ps <- Parser Herb Herb
forall h. Parser h h
get
  if h == s
    then local ps p
    else fail "exactStruct"

-- | Run a parser on the next argument, popping the argument from the argument list.
parseArg :: Parser Herb a -> Parser [Herb] a
parseArg :: forall a. Parser Herb a -> Parser [Herb] a
parseArg Parser Herb a
p = do
  x <- Parser [Herb] [Herb]
forall h. Parser h h
get
  case x of
    (Herb
a:[Herb]
as) -> do
      [Herb] -> Parser [Herb] ()
forall h. h -> Parser h ()
put [Herb]
as
      Herb -> Parser Herb a -> Parser [Herb] a
forall l a h. l -> Parser l a -> Parser h a
local Herb
a Parser Herb a
p
    [Herb]
_ -> String -> Parser [Herb] a
forall a. String -> Parser [Herb] a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseArg"

-- | Parse the next argument to type @a@ (removing it from the current argument
-- list), pass it through a given function to obtain @b@, and return it.
popArg :: FromHerb a => (a -> b) -> Parser [Herb] b
popArg :: forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
popArg a -> b
f = Parser Herb b -> Parser [Herb] b
forall a. Parser Herb a -> Parser [Herb] a
parseArg (a -> b
f (a -> b) -> Parser Herb a -> Parser Herb b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb)

-- | Like `popArg` but without the conversion; equivalent to @popArg id@.
popArg' :: FromHerb a => Parser [Herb] a
popArg' :: forall a. FromHerb a => Parser [Herb] a
popArg' = Parser Herb a -> Parser [Herb] a
forall a. Parser Herb a -> Parser [Herb] a
parseArg Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb

-- | Succeed if all arguments have been already removed by `parseArg`, `popArg`
-- or similar.
endOfArgs :: Parser [h] ()
endOfArgs :: forall h. Parser [h] ()
endOfArgs = do
  x <- Parser [h] [h]
forall h. Parser h h
get
  if null x
    then pure ()
    else fail "endOfArgs"

-- | Shortcut for parsing out exactly one argument of a structure, failing if
-- there are more.
--
-- > parseMaybe :: FromHerb a => Parser Herb (Maybe a)
-- > parseMaybe = Nothing <$ exactAtom "Nothing" <|> exactStruct "Just" (singleArg Just)
singleArg :: FromHerb a => (a -> b) -> Parser [Herb] b
singleArg :: forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
singleArg a -> b
f = (a -> b) -> Parser [Herb] b
forall a b. FromHerb a => (a -> b) -> Parser [Herb] b
popArg a -> b
f Parser [Herb] b -> Parser [Herb] () -> Parser [Herb] b
forall a b. Parser [Herb] a -> Parser [Herb] b -> Parser [Herb] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Herb] ()
forall h. Parser [h] ()
endOfArgs