content: {-# LANGUAGE RecordWildCards #-}
  
  module Dhall.YamlToDhall
    ( Options(..)
    , defaultOptions
    , YAMLCompileError(..)
    , dhallFromYaml
    , schemaFromYaml
    ) where
  
  import Control.Exception (Exception, throwIO)
  import Data.Aeson        (Value)
  import Data.ByteString   (ByteString)
  import Data.Text         (Text)
  import Data.Void         (Void)
  import Dhall.Core        (Expr)
  import Dhall.JSONToDhall
      ( CompileError (..)
      , Conversion (..)
      , defaultConversion
      , dhallFromJSON
      , inferSchema
      , resolveSchemaExpr
      , schemaToDhallType
      , showCompileError
      , typeCheckSchemaExpr
      )
  import Dhall.Src         (Src)
  
  import qualified Data.ByteString.Char8 as BS8
  import qualified Data.YAML.Aeson
  
  -- | Options to parametrize conversion
  data Options = Options
      { schema     :: Maybe Text
      , conversion :: Conversion
      } deriving Show
  
  defaultOptions :: Maybe Text -> Options
  defaultOptions schema = Options {..}
    where conversion = defaultConversion
  
  data YAMLCompileError = YAMLCompileError CompileError
  
  instance Show YAMLCompileError where
      show (YAMLCompileError e) = showCompileError "YAML" showYaml e
  
  instance Exception YAMLCompileError
  
  
  -- | Transform yaml representation into dhall
  dhallFromYaml :: Options -> ByteString -> IO (Expr Src Void)
  dhallFromYaml Options{..} yaml = do
    value <- either (throwIO . userError) pure (yamlToJson yaml)
  
    finalSchema <-
        case schema of
            Just text -> resolveSchemaExpr text
            Nothing   -> return (schemaToDhallType (inferSchema value))
  
    expr <- typeCheckSchemaExpr YAMLCompileError finalSchema
  
    let dhall = dhallFromJSON conversion expr value
  
    either (throwIO . YAMLCompileError) pure dhall
  
  -- | Infer the schema from YAML
  schemaFromYaml :: ByteString -> IO (Expr Src Void)
  schemaFromYaml yaml = do
      value <- either (throwIO . userError) pure (yamlToJson yaml)
  
      return (schemaToDhallType (inferSchema value))
  
  {-| Wrapper around `Data.YAML.Aeson.decode1Strict` that renders the error
      message
  -}
  yamlToJson :: ByteString -> Either String Data.Aeson.Value
  yamlToJson s = case Data.YAML.Aeson.decode1Strict s of
      Right v         -> Right v
      Left (pos, err) -> Left (show pos ++ err)
  
  showYaml :: Value -> String
  showYaml value = BS8.unpack (Data.YAML.Aeson.encode1Strict value)
  