    {-# LANGUAGE OverloadedStrings #-}

    module Data.SCargot.Language.Basic
      ( -- * Spec
        -- $descr
        basicParser
      , basicPrinter
      , locatedBasicParser
      , locatedBasicPrinter
      ) where

    import           Control.Applicative ((<$>))
    import           Data.Char (isAlphaNum)
    import           Text.Parsec (many1, satisfy)
    import           Data.Text (Text, pack)
    import           Data.Functor.Identity (Identity)
    import           Text.Parsec.Prim (ParsecT)

    import           Data.SCargot.Common (Located(..), located)
    import           Data.SCargot.Repr.Basic (SExpr)
    import           Data.SCargot ( SExprParser
                                  , SExprPrinter
                                  , mkParser
                                  , flatPrint
                                  )

    isAtomChar :: Char -> Bool
    isAtomChar :: Char -> Bool
    isAtomChar Char
    c = Char -> Bool
    isAlphaNum Char
    c
      Bool -> Bool -> Bool
    || 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
    '*' Bool -> Bool -> Bool
    || 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
    '+' Bool -> Bool -> Bool
    || 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
    '>'
      Bool -> Bool -> Bool
    || 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
    '!' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '?'

    pToken :: ParsecT Text a Identity Text
    pToken :: forall a. ParsecT Text a Identity Text
    pToken = String -> Text
    pack (String -> Text)
    -> ParsecT Text a Identity String -> ParsecT Text a Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text a Identity Char -> ParsecT Text a Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ((Char -> Bool) -> ParsecT Text a Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy Char -> Bool
    isAtomChar)

    -- $descr
    -- The 'basicSpec' describes S-expressions whose atoms are simply
    -- text strings that contain alphanumeric characters and a small
    -- set of punctuation. It does no parsing of numbers or other data
    -- types, and will accept tokens that typical Lisp implementations
    -- would find nonsensical (like @77foo@).
    --
    -- Atoms recognized by the 'basicSpec' are any string matching the
    -- regular expression @[A-Za-z0-9+*<>/=!?-]+@.

    -- | A 'SExprParser' that understands atoms to be sequences of
    --   alphanumeric characters as well as the punctuation
    --   characters @[-*/+<>=!?]@, and does no processing of them.
    --
    -- >>> decode basicParser "(1 elephant)"
    -- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)]
    basicParser :: SExprParser Text (SExpr Text)
    basicParser :: SExprParser Text (SExpr Text)
    basicParser = Parser Text -> SExprParser Text (SExpr Text)
    forall atom. Parser atom -> SExprParser atom (SExpr atom)
    mkParser Parser Text
    forall a. ParsecT Text a Identity Text
    pToken

    -- | A 'basicParser' which produces 'Located' values
    --
    -- >>> decode locatedBasicParser $ pack "(1 elephant)"
    -- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
    --
    -- >>> decode locatedBasicParser $ pack "(let ((x 1))\n  x)"
    -- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 5)) "let")) (SCons (SCons (SCons (SAtom (At (Span (line 1, column 8) (line 1, column 9)) "x")) (SCons (SAtom (At (Span (line 1, column 10) (line 1, column 11)) "1")) SNil)) SNil) (SCons (SAtom (At (Span (line 2, column 3) (line 2, column 4)) "x")) SNil))]
    locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
    locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
    locatedBasicParser = Parser (Located Text)
    -> SExprParser (Located Text) (SExpr (Located Text))
    forall atom. Parser atom -> SExprParser atom (SExpr atom)
    mkParser (Parser (Located Text)
     -> SExprParser (Located Text) (SExpr (Located Text)))
    -> Parser (Located Text)
    -> SExprParser (Located Text) (SExpr (Located Text))
    forall a b. (a -> b) -> a -> b
    $ Parser Text -> Parser (Located Text)
    forall a. Parser a -> Parser (Located a)
    located Parser Text
    forall a. ParsecT Text a Identity Text
    pToken

    -- | A 'SExprPrinter' that prints textual atoms directly (without quoting
    --   or any other processing) onto a single line.
    --
    -- >>> encode basicPrinter [L [A "1", A "elephant"]]
    -- "(1 elephant)"
    basicPrinter :: SExprPrinter Text (SExpr Text)
    basicPrinter :: SExprPrinter Text (SExpr Text)
    basicPrinter = (Text -> Text) -> SExprPrinter Text (SExpr Text)
    forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    flatPrint Text -> Text
    forall a. a -> a
    id

    -- | A 'SExprPrinter' for 'Located' values. Works exactly like 'basicPrinter'
    --   It ignores the location tags when printing the result.
    --
    -- >>> let (Right dec) = decode locatedBasicParser $ pack "(1 elephant)"
    -- [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
    --
    -- >>> encode locatedBasicPrinter dec
    -- "(1 elephant)"
    locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))
    locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))
    locatedBasicPrinter = (Located Text -> Text)
    -> SExprPrinter (Located Text) (SExpr (Located Text))
    forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    flatPrint Located Text -> Text
    forall {a}. Located a -> a
    unLoc
      where unLoc :: Located a -> a
    unLoc (At Location
    _loc a
    e) = a
    e