--------------------------------------------------------------------- -- -- Module : Uniform.Yaml -- TOD separate markdown ---------------------------------------------------------------------- -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} -- {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -- {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} module Uniform.Yaml ( module Uniform.Yaml, -- module Uniform.Error, -- or at least ErrIO, -- , Y.decodeEither' Y.ParseException (..), -- , module Data.Yaml Y.decodeFileThrow, Y.encode, Y.decode, Y.decodeEither, Options(..) ) where -- import Path -- (Path, Abs, Rel, File, Dir) -- import Uniform.FileIO (read8, Extension(..)) import Data.Aeson.Types (Options(..)) import qualified Data.Yaml as Y import UniformBase -- import Uniform.Error -- import Unifor.Strings -- import Uniform.FileIO import Uniform.Json -- import Uniform.TypedFile (TypedFile5 (..), TypedFiles7 (..)) decodeThrowT :: Text -> ErrIO Value decodeThrowT = Y.decodeThrow . t2b newtype YamlText = YamlText Text deriving (Show, Read, Eq, Ord) -- a wrapper around Markdonw text -- todo clean up - use wrap7 unYAML :: YamlText -> Text unYAML (YamlText a) = a --needed for other ops extYAML :: Extension extYAML = Extension "yaml" yamlFileType :: TypedFile5 Text YamlText instance Zeros YamlText where zero = YamlText zero yamlFileType = TypedFile5 {tpext5 = extYAML} :: TypedFile5 Text YamlText --instance FileHandles YamlText -- what is missing here? instance TypedFiles7 Text YamlText where -- handling Markdown and read them into YamlText wrap7 = YamlText unwrap7 (YamlText a) = a readYaml2value :: Path Abs File -> ErrIO Value -- read a yaml file to a value -- error when syntax issue readYaml2value fp = do t <- read8 fp yamlFileType return . (yaml2value fp) $ t yaml2value :: Path Abs File -> YamlText -> Value -- convert a YamlText to a JSON value, error if not ok -- how to debug input erros? yaml2value fp yt = either (errorT . show2) Prelude.id vx where show2 a = ["Yaml error in file (line count start 0)", showT fp, ":", showT a] vx = Y.decodeEither' (t2b . unYAML $ yt) :: Either Y.ParseException Value readYaml2rec :: (FromJSON a, Show a) => Path Abs File -> ErrIO a -- | read a yaml file into a record Value -- error when syntax fault readYaml2rec fn = do -- putIOwords [" yaml file name", showT fn ] -- settingsTxt <- read8 settingsfilename yamlFileType s0 :: Value <- readYaml2value fn -- putIOwords ["yaml read", showPretty s0 ] s1 <- fromJSONerrio s0 -- :: Result Settings -- putIOwords ["json parsed", showT s1 ] return s1 -- for a test use readSettingsfile