content: {-# LANGUAGE OverloadedStrings #-}
  
  module Data.SCargot.Language.Basic
    ( -- * Spec
      -- $descr
      basicParser,
      basicPrinter,
      locatedBasicParser,
      locatedBasicPrinter,
    )
  where
  
  import Control.Applicative ((<$>))
  import Data.Char (isAlphaNum)
  import Data.Functor.Identity (Identity)
  import Data.SCargot
    ( SExprParser,
      SExprPrinter,
      flatPrint,
      mkParser,
    )
  import Data.SCargot.Common (Located (..), located)
  import Data.SCargot.Repr.Basic (SExpr)
  import Data.Text (Text, pack)
  import Text.Parsec (many1, satisfy)
  import Text.Parsec.Prim (ParsecT)
  
  isAtomChar :: Char -> Bool
  isAtomChar c =
    isAlphaNum c
      || c == '-'
      || c == '*'
      || c == '/'
      || c == '+'
      || c == '<'
      || c == '>'
      || c == '='
      || c == '!'
      || c == '?'
  
  pToken :: ParsecT Text a Identity Text
  pToken = pack <$> many1 (satisfy 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 = mkParser 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 = mkParser $ located 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 = flatPrint 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 = flatPrint unLoc
    where
      unLoc (At _loc e) = e
  