Parsing S-expressions in Haskell (using S-Cargot)

Sexp_parser.hs

module Main where

import qualified Data.Text as T
import qualified Text.Parsec.Pos as P
import qualified Data.SCargot as S
import qualified Data.SCargot.Common as C
import qualified Data.SCargot.Language.Basic as B
import qualified Data.SCargot.Repr.WellFormed as W

type Sexp = W.WellFormedExpr (C.Located T.Text)
type SexpParser = S.SExprParser (C.Located T.Text) Sexp
type SexpPrinter = S.SExprPrinter (C.Located T.Text) Sexp

parser :: SexpParser
parser = S.asWellFormed B.locatedBasicParser

printer :: SexpPrinter
printer = S.setFromCarrier W.fromWellFormed (B.locatedBasicPrinter)

data File_loc = File_loc
  { startLine :: Int
  , startCol :: Int
  , endLine :: Int
  , endCol :: Int
  } deriving Show

mkFileLoc :: C.Location -> File_loc
mkFileLoc loc =
  case loc of
    C.Span loc1 loc2 ->
      File_loc
        { startLine = P.sourceLine loc1
        , startCol = P.sourceColumn loc1
        , endLine = P.sourceLine loc2
        , endCol = P.sourceColumn loc2
        }

showLocOf :: Sexp -> String
showLocOf sexp =
  case sexp of
    W.WFSAtom (C.At loc sexp) -> show (mkFileLoc loc)
    W.WFSList [] -> ""
    W.WFSList (x : xs) -> showLocOf x

failParse :: Sexp -> String -> Either String a
failParse sexp msg =
  let loc = showLocOf sexp
      source = S.encodeOne printer sexp
      err = "Error " ++ loc ++ " - " ++ msg ++ ": " ++ (T.unpack source)

parse :: T.Text -> Either String String
parse text = do
  sexps <- S.decode parser text
  Right $ T.unpack (S.encode printer sexps)