{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module HsInspect.Sexp where
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T
import FastString (unpackFS)
import Json (escapeJsonString)
import Module (ModuleName, moduleNameString)
import PackageConfig (PackageName(..), SourcePackageId(..))
data Sexp
= SexpCons Sexp Sexp
| SexpNil
| SexpString Text
| SexpSymbol Text
list :: [Sexp] -> Sexp
list = foldr SexpCons SexpNil
toList :: Sexp -> Maybe [Sexp]
toList SexpNil = Just []
toList (SexpCons a b) = (a :) <$> toList b
toList _ = Nothing
instance IsString Sexp where
fromString = SexpSymbol . T.pack
alist :: [(Sexp, Sexp)] -> Sexp
alist els = list $ mkEl =<< els
where
mkEl (k, v) = [SexpCons k v]
toAList :: Sexp -> Maybe [(Text, Sexp)]
toAList SexpNil = Just []
toAList (SexpCons (SexpCons (SexpSymbol k) v) rest) = ((k, v) :) <$> toAList rest
toAList _ = Nothing
class ToSexp a where
toSexp :: a -> Sexp
instance ToSexp Sexp where
toSexp = id
instance ToSexp Text where
toSexp = SexpString
instance ToSexp Bool where
toSexp False = SexpNil
toSexp True = SexpSymbol "t"
instance ToSexp a => ToSexp [a] where
toSexp as = list $ toSexp <$> as
instance ToSexp a => ToSexp (Maybe a) where
toSexp (Just a) = toSexp a
toSexp Nothing = SexpNil
instance ToSexp SourcePackageId where
toSexp (SourcePackageId fs) = SexpString . T.pack $ unpackFS fs
instance ToSexp ModuleName where
toSexp = SexpString . T.pack . moduleNameString
instance ToSexp PackageName where
toSexp (PackageName fs) = SexpString . T.pack $ unpackFS fs
filterNil :: Sexp -> Sexp
filterNil SexpNil = SexpNil
filterNil (SexpCons (SexpCons (SexpSymbol _) SexpNil) rest) = filterNil rest
filterNil (SexpCons car cdr) = (SexpCons (filterNil car) (filterNil cdr))
filterNil (SexpString s) = SexpString s
filterNil (SexpSymbol s) = SexpSymbol s
render :: Sexp -> Text
render SexpNil = "nil"
render (toList -> Just ss) = "(" <> (T.intercalate " " $ render <$> ss) <> ")\n"
render (SexpCons a b) = "(" <> render a <> " . " <> render b <> ")\n"
render (SexpString s) = "\"" <> (T.pack . escapeJsonString $ T.unpack s) <> "\""
render (SexpSymbol a) = T.pack . escapeJsonString $ T.unpack a