67 lines
1.7 KiB
Haskell
67 lines
1.7 KiB
Haskell
|
module Data.Language.TypeScript
|
||
|
( Statement(..)
|
||
|
, Type(..)
|
||
|
, Name(..)
|
||
|
, TypeDeclaration(..)
|
||
|
, Primitive(..)
|
||
|
, Object(..)
|
||
|
, Union(..)
|
||
|
) where
|
||
|
{-# OPTIONS_GHC -Wall #-}
|
||
|
|
||
|
import Data.Text (Text)
|
||
|
import Data.Text.Prettyprint.Doc
|
||
|
import Data.Map (Map)
|
||
|
import qualified Data.Map as Map
|
||
|
import Data.List
|
||
|
|
||
|
deriving stock instance Show Name
|
||
|
newtype Name = Name Text
|
||
|
|
||
|
deriving stock instance Show Statement
|
||
|
data Statement = StatementTypeDeclaration TypeDeclaration
|
||
|
|
||
|
instance Pretty Name where
|
||
|
pretty (Name nm) = pretty nm
|
||
|
|
||
|
data TypeDeclaration = TypeDeclaration Name Type
|
||
|
deriving stock instance Show TypeDeclaration
|
||
|
instance Pretty TypeDeclaration where
|
||
|
pretty = error "TODO"
|
||
|
|
||
|
data Primitive = TsText | TsInteger
|
||
|
deriving stock instance Show Primitive
|
||
|
instance Pretty Primitive where
|
||
|
pretty = \case
|
||
|
TsText -> "string"
|
||
|
TsInteger -> "number"
|
||
|
|
||
|
newtype Object = Object (Map Text Type)
|
||
|
deriving stock instance Show Object
|
||
|
instance Pretty Object where
|
||
|
pretty (Object m) = vsep $ ["{", nest 2 (vsep docs), "}"]
|
||
|
where
|
||
|
docs = decl <$> Map.toList m
|
||
|
decl :: (Text, Type) -> Doc ann
|
||
|
decl (txt, tp) = pretty txt <> ":" <+> pretty tp <> ";"
|
||
|
|
||
|
newtype Union = Union ([] Type)
|
||
|
|
||
|
deriving stock instance Show Union
|
||
|
instance Pretty Union where
|
||
|
pretty (Union tps) = sepBy "|" $ pretty <$> tps
|
||
|
|
||
|
sepBy :: Doc a -> [Doc a] -> Doc a
|
||
|
sepBy x = sep . intersperse x
|
||
|
|
||
|
data Type = Primitive Primitive | TypeObject Object | TypeUnion Union | Array Type | TypeNamed Name
|
||
|
deriving stock instance Show Type
|
||
|
instance Pretty Type where
|
||
|
pretty = \case
|
||
|
Primitive p -> pretty p
|
||
|
TypeObject o -> pretty o
|
||
|
TypeUnion u -> pretty u
|
||
|
Array a -> pretty a
|
||
|
TypeNamed n -> pretty n
|
||
|
|