| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.AttoLisp
Description
Efficient parsing and serialisation of S-Expressions (as used by Lisp).
This module is intended to be imported qualified, e.g.:
import qualified Data.AttoLisp as L
Synopsis
- data Lisp
- nil :: Lisp
- isNull :: Lisp -> Bool
- class FromLisp a where
- data Result a
- fromLisp :: FromLisp a => Lisp -> Result a
- type Failure f r = String -> f r
- type Success a f r = a -> f r
- data Parser a
- parse :: (a -> Parser b) -> a -> Result b
- parseMaybe :: (a -> Parser b) -> a -> Maybe b
- parseEither :: (a -> Parser b) -> a -> Either String b
- typeMismatch :: String -> Lisp -> Parser a
- class ToLisp a where
- mkStruct :: Text -> [Lisp] -> Lisp
- struct :: ParseList f a => Text -> f -> Lisp -> Parser a
- encode :: ToLisp a => a -> ByteString
- fromLispExpr :: Lisp -> Builder
- lisp :: Parser Lisp
- atom :: Parser Lisp
Core Lisp Types
A Lisp expression (S-expression).
Symbols are case-sensitive.
NOTE: The Number type is deprecated in "attoparsec", so a future version of
"atto-lisp" will switch to the Scientific type from the "scientific"
package.
Constructors
| Symbol Text | A symbol (including keyword) |
| String Text | A string. |
| Number Number | A number |
| List [Lisp] | A proper list: |
| DotList [Lisp] Lisp | A list with a non-nil tail: |
Instances
| Eq Lisp Source # | |
| Data Lisp Source # | |
Defined in Data.AttoLisp Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Lisp -> c Lisp # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Lisp # dataTypeOf :: Lisp -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Lisp) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lisp) # gmapT :: (forall b. Data b => b -> b) -> Lisp -> Lisp # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lisp -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lisp -> r # gmapQ :: (forall d. Data d => d -> u) -> Lisp -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Lisp -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Lisp -> m Lisp # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Lisp -> m Lisp # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Lisp -> m Lisp # | |
| Ord Lisp Source # | |
| Show Lisp Source # | |
| IsString Lisp Source # | |
Defined in Data.AttoLisp Methods fromString :: String -> Lisp # | |
| NFData Lisp Source # | |
Defined in Data.AttoLisp | |
| FromLisp Lisp Source # | |
| ToLisp Lisp Source # | |
Type Conversion
class FromLisp a where Source #
A type that can be converted from an S-expression, with the possibility of failure.
When writing an instance, use mzero or fail to make a
conversion fail, e.g. the value is of the wrong type.
An example type and instance:
@data Coord { x :: Double, y :: Double }
instance FromLisp Coord where
parseLisp (DotList [x] y) = pure (Coord x y)
-- A non-DotList value is of the wrong shape, so use mzero to fail.
parseLisp _ = mzero
@
The above instance expects that Coord 4 5 is encoded as (4
. 5). This makes sense for a few special types, but most of the
time the standard encoding should be used: (coord 4 5). The
struct combinator provides special support for this use case:
instance FromLisp Coord where
parseLisp = struct "coord" Coord
It uses some special type class magic to figure out the arity of its second argument.
Minimal complete definition
Instances
| FromLisp Bool Source # | |
| FromLisp Char Source # | |
| FromLisp Double Source # | |
| FromLisp Float Source # | |
| FromLisp Int Source # | |
| FromLisp Int8 Source # | |
| FromLisp Int16 Source # | |
| FromLisp Int32 Source # | |
| FromLisp Int64 Source # | |
| FromLisp Integer Source # | |
| FromLisp Word Source # | |
| FromLisp Word8 Source # | |
| FromLisp Word16 Source # | |
| FromLisp Word32 Source # | |
| FromLisp Word64 Source # | |
| FromLisp () Source # | |
| FromLisp Text Source # | |
| FromLisp Number Source # | |
| FromLisp Lisp Source # | |
| FromLisp [Char] Source # | |
| FromLisp a => FromLisp [a] Source # | |
| FromLisp a => FromLisp (Maybe a) Source # | |
| FromLisp (Ratio Integer) Source # | |
| (FromLisp a, FromLisp b) => FromLisp (Either a b) Source # | Tries to parse |
| (FromLisp a, FromLisp b) => FromLisp (a, b) Source # | |
| (Ord a, FromLisp a, FromLisp b) => FromLisp (Map a b) Source # | |
| (FromLisp a, FromLisp b, FromLisp c) => FromLisp (a, b, c) Source # | |
The result of running a Parser.
Instances
| Monad Result Source # | |
| Functor Result Source # | |
| Applicative Result Source # | |
| Alternative Result Source # | |
| MonadPlus Result Source # | |
| Eq a => Eq (Result a) Source # | |
| Show a => Show (Result a) Source # | |
| Semigroup (Result a) Source # | |
| Monoid (Result a) Source # | |
| NFData a => NFData (Result a) Source # | |
Defined in Data.AttoLisp | |
A continuation-based parser type.
Arguments
| :: String | The name of the type you are trying to parse. |
| -> Lisp | The actual value encountered. |
| -> Parser a |
Fail parsing due to a type mismatch, with a descriptive message.
A type that can be converted to an S-expression.
An example type and instance:
@data Coord { x :: Double, y :: Double }
instance ToLisp Coord where
toLisp (Coord x y) = struct "coord" [toLisp x, toLisp y]
@
Minimal complete definition
Instances
| ToLisp Bool Source # | |
| ToLisp Char Source # | |
| ToLisp Double Source # | |
| ToLisp Float Source # | |
| ToLisp Int Source # | |
| ToLisp Int8 Source # | |
| ToLisp Int16 Source # | |
| ToLisp Int32 Source # | |
| ToLisp Int64 Source # | |
| ToLisp Integer Source # | |
| ToLisp Word Source # | |
| ToLisp Word8 Source # | |
| ToLisp Word16 Source # | |
| ToLisp Word32 Source # | |
| ToLisp Word64 Source # | |
| ToLisp () Source # | |
Defined in Data.AttoLisp | |
| ToLisp Text Source # | |
| ToLisp Number Source # | |
| ToLisp Lisp Source # | |
| ToLisp [Char] Source # | |
| ToLisp a => ToLisp [a] Source # | |
Defined in Data.AttoLisp | |
| ToLisp a => ToLisp (Maybe a) Source # | |
| ToLisp (Ratio Integer) Source # | |
| (ToLisp a, ToLisp b) => ToLisp (Either a b) Source # | No tag is used, hence type |
| (ToLisp a, ToLisp b) => ToLisp (a, b) Source # | |
Defined in Data.AttoLisp | |
| (ToLisp a, ToLisp b) => ToLisp (Map a b) Source # | |
| (ToLisp a, ToLisp b, ToLisp c) => ToLisp (a, b, c) Source # | |
Defined in Data.AttoLisp | |
Constructors and destructors
mkStruct :: Text -> [Lisp] -> Lisp Source #
Create a Lisp struct in a standardised format.
Fields in a struct are accessed by position.
struct :: ParseList f a => Text -> f -> Lisp -> Parser a Source #
Decode structure serialised with mkStruct.
The second argument should be a function, usually a constructor. The resulting parser automatically figures out the arity of the function. For example:
@data Foo = Foo Int deriving (Eq, Show)
parseFoo :: Lisp -> Parser Foo
parseFoo = struct "foo" Foo
test = parseMaybe parseFoo val == Just (Foo 23)
where val = List [Symbol "foo", Number 23]
@
Encoding and parsing
encode :: ToLisp a => a -> ByteString Source #
fromLispExpr :: Lisp -> Builder Source #