125 lines
4.7 KiB
Haskell
125 lines
4.7 KiB
Haskell
module Dhall.TypeScript (main) where
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
|
|
import qualified Dhall.Core as Dhall
|
|
import qualified Dhall.Parser
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Data.Text.IO as Text
|
|
import qualified Data.Language.TypeScript as TypeScript
|
|
import qualified Data.Text.Prettyprint.Doc as Pretty
|
|
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
|
|
import qualified Data.Map as Map
|
|
import Data.Text (Text)
|
|
import qualified Dhall.Map as Dhall
|
|
import Control.Monad
|
|
|
|
main :: IO ()
|
|
main = do
|
|
txt <- Text.getContents
|
|
e <- Dhall.throws (Dhall.Parser.exprFromText (fromMaybe "(stdin)" mFilePath) txt)
|
|
case fromDhall e of
|
|
Nothing -> Text.putStrLn "Could not convert expression"
|
|
Just expr -> Pretty.putDoc $ Pretty.pretty expr <> "\n"
|
|
|
|
fromDhall :: Show a => Show b => Dhall.Expr a b -> Maybe TypeScript.Type
|
|
fromDhall e = case e of
|
|
Dhall.Annot{} -> err
|
|
Dhall.App{} -> err
|
|
Dhall.Assert{} -> err
|
|
Dhall.BoolAnd{} -> err
|
|
Dhall.BoolEQ{} -> err
|
|
Dhall.BoolIf{} -> err
|
|
Dhall.BoolLit{} -> err
|
|
Dhall.BoolNE{} -> err
|
|
Dhall.BoolOr{} -> err
|
|
Dhall.Bool{} -> err
|
|
Dhall.CombineTypes{} -> err
|
|
Dhall.Combine{} -> err
|
|
Dhall.Const{} -> err
|
|
Dhall.DoubleLit{} -> err
|
|
Dhall.DoubleShow{} -> err
|
|
Dhall.Double{} -> err
|
|
Dhall.Embed{} -> err
|
|
Dhall.Equivalent{} -> err
|
|
Dhall.Field{} -> err
|
|
Dhall.ImportAlt{} -> err
|
|
Dhall.IntegerClamp{} -> err
|
|
Dhall.IntegerLit{} -> err
|
|
Dhall.IntegerNegate{} -> err
|
|
Dhall.IntegerShow{} -> err
|
|
Dhall.IntegerToDouble{} -> err
|
|
Dhall.Integer{} -> pure (TypeScript.Primitive TypeScript.TsInteger)
|
|
Dhall.Lam{} -> err
|
|
Dhall.Let{} -> err
|
|
Dhall.ListAppend{} -> err
|
|
Dhall.ListBuild{} -> err
|
|
Dhall.ListFold{} -> err
|
|
Dhall.ListHead{} -> err
|
|
Dhall.ListIndexed{} -> err
|
|
Dhall.ListLast{} -> err
|
|
Dhall.ListLength{} -> err
|
|
Dhall.ListLit{} -> err
|
|
Dhall.ListReverse{} -> err
|
|
Dhall.List{} -> err
|
|
Dhall.Merge{} -> err
|
|
Dhall.NaturalBuild{} -> err
|
|
Dhall.NaturalEven{} -> err
|
|
Dhall.NaturalFold{} -> err
|
|
Dhall.NaturalIsZero{} -> err
|
|
Dhall.NaturalLit{} -> err
|
|
Dhall.NaturalOdd{} -> err
|
|
Dhall.NaturalPlus{} -> err
|
|
Dhall.NaturalShow{} -> err
|
|
Dhall.NaturalSubtract{} -> err
|
|
Dhall.NaturalTimes{} -> err
|
|
Dhall.NaturalToInteger{} -> err
|
|
Dhall.Natural{} -> pure (TypeScript.Primitive TypeScript.TsInteger)
|
|
Dhall.None{} -> err
|
|
Dhall.Note _ e0 -> fromDhall e0
|
|
Dhall.OptionalBuild{} -> err
|
|
Dhall.OptionalFold{} -> err
|
|
Dhall.Optional{} -> err
|
|
Dhall.Pi{} -> err
|
|
Dhall.Prefer{} -> err
|
|
Dhall.Project{} -> err
|
|
Dhall.RecordCompletion{} -> err
|
|
Dhall.RecordLit{} -> err
|
|
Dhall.Record r -> TypeScript.TypeObject <$> fromDhall_Object r
|
|
Dhall.Some{} -> err
|
|
Dhall.TextAppend{} -> err
|
|
Dhall.TextLit{} -> err
|
|
Dhall.TextShow{} -> err
|
|
Dhall.Text -> pure $ TypeScript.Primitive TypeScript.TsText
|
|
Dhall.ToMap{} -> err
|
|
Dhall.Union u -> TypeScript.TypeUnion <$> fromDhall_Union u
|
|
Dhall.Var v -> fromDhall_Named v
|
|
where
|
|
err = error $ show e
|
|
|
|
fromDhall_Union :: forall a b . Show a => Show b => Dhall.Map Text (Maybe (Dhall.Expr a b)) -> Maybe TypeScript.Union
|
|
-- TODO: Maybe Map.fromList + Dhall.toList is a bit silly here.
|
|
fromDhall_Union
|
|
= traverse go . Dhall.toList
|
|
>=> fmap TypeScript.Union . traverse unionand
|
|
where
|
|
-- TODO: Dunno what it means when a dhall union has a Nothing as an entry.
|
|
go :: (Text, Maybe (Dhall.Expr a b)) -> Maybe (Text, Dhall.Expr a b)
|
|
go (_, Nothing) = Nothing
|
|
go (t, Just x) = pure $ (t, x)
|
|
-- Will fail if `expr` fails to translate.
|
|
unionand :: (Text, Dhall.Expr a b) -> Maybe TypeScript.Type
|
|
-- unionand (txt, expr) = (txt,) <$> fromDhall expr
|
|
unionand (txt, expr) = (\x -> TypeScript.TypeObject $ TypeScript.Object $ Map.singleton txt x) <$> fromDhall expr
|
|
|
|
-- TODO: Maybe Map.fromList + Dhall.toList is a bit silly here.
|
|
fromDhall_Object :: Show a => Show b => Dhall.Map Text (Dhall.Expr a b) -> Maybe TypeScript.Object
|
|
fromDhall_Object = fmap (TypeScript.Object . Map.fromList) . traverse @_ @Maybe go . Dhall.toList
|
|
where
|
|
go (txt, expr) = (txt,) <$> fromDhall expr
|
|
|
|
fromDhall_Named :: Dhall.Var -> Maybe TypeScript.Type
|
|
fromDhall_Named (Dhall.V nm _) = pure $ TypeScript.TypeNamed $ TypeScript.Name nm
|
|
|
|
mFilePath :: Maybe FilePath
|
|
mFilePath = Nothing
|