datum grammar

src/Gyehoek/Sexp/Syntax.hs

@@ -33,18 +33,24 @@ module Gyehoek.Sexp.Syntax
   , pattern Character
   , pattern Number
   , pattern Boolean
+  , Ann(..)
+  , noAnn
+  , ann
+  , pattern List'
+  , position
   ) where
 
 import Language.Haskell.TH.Syntax (Lift)
 import Data.Scientific (Scientific)
 import Data.ByteString (ByteString)
 import Gyehoek.Prelude hiding ((:<), Simple)
-import Text.Megaparsec.Pos (SourcePos(..))
+import Text.Megaparsec.Pos (SourcePos(..), sourcePosPretty)
 import Control.Comonad.Cofree (Cofree((:<)), _extract)
 import Data.Fix (Fix (..))
 import Data.Functor.Foldable
 import Text.Show.Deriving (deriveShow1)
 import qualified Control.Comonad.Trans.Cofree as F
+import Prettyprinter (Pretty (pretty), viaShow)
 
 
 data DatumF a
@@ -62,6 +68,8 @@ data Simple
   | SimpleString Text
   | SimpleSymbol Text
   | SimpleBytevector ByteString
+  | SimpleMeta Text
+  | SimpleMetaSplice Text
   deriving stock (Show, Eq, Data, Generic, Lift)
   deriving anyclass (NFData)
 
@@ -92,7 +100,7 @@ newtype Label = MkLabel Natural
 
 
 
-type Datum = Cofree DatumF Syn
+type Datum = Cofree DatumF Ann
 type Compound = CompoundF Datum
 
 data Indentation
@@ -109,15 +117,37 @@ data Syn
   | SynString
   | SynConstant
   | SynNone
-  deriving (Show, Read)
+  deriving (Show, Read, Data, Generic, Eq, Lift)
+
+data Ann = MkAnn
+  { syntax :: Syn
+  , position :: Maybe SourcePos
+  }
+  deriving (Show, Data, Eq, Generic)
+
+noAnn :: Ann
+noAnn = MkAnn
+  { syntax = SynNone
+  , position = Nothing
+  }
+
+-- requisite of the Pretty instance for invertible-grammar's error type.
+instance Pretty Ann where
+  pretty = pretty . maybe "<unknown>" sourcePosPretty . view #position
 
 
 
 deriveShow1 ''CompoundF
 deriveShow1 ''DatumF
 
+ann :: Lens' Datum Ann
+ann = _extract
+
 syntax :: Lens' Datum Syn
-syntax = _extract
+syntax = ann . #syntax
+
+position :: Lens' Datum (Maybe SourcePos)
+position = ann . #position
 
 indentation :: Traversal' Datum Indentation
 indentation k (syn :< CompoundF (ListF ind xs)) = do
@@ -126,42 +156,46 @@ indentation k (syn :< CompoundF (ListF ind xs)) = do
 indentation k a = pure a
 
 adorn :: Syn -> Datum -> Datum
-adorn syn (_ :< d) = syn :< d
+adorn = set syntax
 
 indentWith :: Indentation -> Datum -> Datum
 indentWith = set indentation
 
 pattern Simple :: Simple -> Datum
 pattern Simple a <- _ :< SimpleF a
-  where Simple a = SynNone :< SimpleF a
+  where Simple a = noAnn :< SimpleF a
 
 pattern Compound :: CompoundF Datum -> Datum
 pattern Compound a <- _ :< CompoundF a
-  where Compound a = SynNone :< CompoundF a
+  where Compound a = noAnn :< CompoundF a
 
 pattern Labeled :: Label -> Datum -> Datum
 pattern Labeled l a <- _ :< LabeledF l a
-  where Labeled l a = SynNone :< LabeledF l a
+  where Labeled l a = noAnn :< LabeledF l a
 
 pattern LabelRef :: Label -> Datum
 pattern LabelRef l <- _ :< LabelRefF l
-  where LabelRef l = SynNone :< LabelRefF l
+  where LabelRef l = noAnn :< LabelRefF l
 
 pattern List :: List Datum -> Datum
 pattern List a <- _ :< CompoundF (ListF _ a)
-  where List a = SynNone :< CompoundF (ListF Ordinary a)
+  where List a = noAnn :< CompoundF (ListF Ordinary a)
+
+pattern List' :: Indentation -> List Datum -> Datum
+pattern List' ind a <- _ :< CompoundF (ListF ind a)
+  where List' ind a = noAnn :< CompoundF (ListF ind a)
 
 pattern DotList :: NonEmpty Datum -> Datum -> Datum
 pattern DotList xs x <- _ :< CompoundF (DotListF xs x)
-  where DotList xs x = SynNone :< CompoundF (DotListF xs x)
+  where DotList xs x = noAnn :< CompoundF (DotListF xs x)
 
 pattern Vector :: [Datum] -> Datum
 pattern Vector xs <- _ :< CompoundF (VectorF xs)
-  where Vector xs = SynNone :< CompoundF (VectorF xs)
+  where Vector xs = noAnn :< CompoundF (VectorF xs)
 
 pattern Abbrev :: Prefix -> Datum -> Datum
 pattern Abbrev p a <- _ :< CompoundF (AbbrevF p a)
-  where Abbrev p a = SynNone :< CompoundF (AbbrevF p a)
+  where Abbrev p a = noAnn :< CompoundF (AbbrevF p a)
 
 pattern Boolean a = Simple (SimpleBoolean a)
 pattern Number a = Simple (SimpleNumber a)