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