74 lines
1.5 KiB
Haskell
74 lines
1.5 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
module Data.Config.Suckless.Syntax
|
|
( Syntax(..)
|
|
, Context(..)
|
|
, Id(..)
|
|
, Literal(..)
|
|
, HasContext(..)
|
|
, pattern SymbolVal
|
|
)
|
|
where
|
|
|
|
import GHC.Generics
|
|
import Data.Text (Text)
|
|
import Data.Data
|
|
import Data.String
|
|
import Data.Kind
|
|
|
|
import Prettyprinter
|
|
|
|
pattern SymbolVal :: Id -> Syntax c
|
|
pattern SymbolVal v <- Symbol _ v
|
|
|
|
data family Context c :: Type
|
|
|
|
class HasContext c a where
|
|
setContext :: Context c -> a -> a
|
|
getContext :: a -> Context c
|
|
|
|
newtype Id =
|
|
Id Text
|
|
deriving newtype (IsString,Pretty)
|
|
deriving stock (Data,Generic,Show,Eq,Ord)
|
|
|
|
data Literal =
|
|
LitStr Text
|
|
| LitInt Integer
|
|
| LitBool Bool
|
|
deriving stock (Eq,Ord,Data,Generic,Show)
|
|
|
|
data Syntax c
|
|
= List (Context c) [Syntax c]
|
|
| Symbol (Context c) Id
|
|
| Literal (Context c) Literal
|
|
deriving stock (Generic)
|
|
|
|
instance HasContext c (Syntax c) where
|
|
setContext c1 = \case
|
|
List _ v -> List c1 v
|
|
Symbol _ v -> Symbol c1 v
|
|
Literal _ v -> Literal c1 v
|
|
|
|
getContext = \case
|
|
List x _ -> x
|
|
Symbol x _ -> x
|
|
Literal x _ -> x
|
|
|
|
instance Pretty (Syntax c) where
|
|
pretty (Literal _ ast) = pretty ast
|
|
pretty (Symbol _ s) = pretty s
|
|
pretty (List _ (x:xs)) = parens $ align $ sep ( fmap pretty (x:xs) )
|
|
pretty (List _ []) = parens mempty
|
|
|
|
instance Pretty Literal where
|
|
pretty = \case
|
|
LitStr s -> dquotes (pretty s)
|
|
LitInt i -> pretty i
|
|
|
|
LitBool b | b -> "#t"
|
|
| otherwise -> "#f"
|
|
|
|
|