---------------------------------------------------------------------
--
-- 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 :: Text -> ErrIO Value
decodeThrowT = forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Y.decodeThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
t2b

newtype YamlText = YamlText Text deriving (Int -> YamlText -> ShowS
[YamlText] -> ShowS
YamlText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [YamlText] -> ShowS
$cshowList :: [YamlText] -> ShowS
show :: YamlText -> String
$cshow :: YamlText -> String
showsPrec :: Int -> YamlText -> ShowS
$cshowsPrec :: Int -> YamlText -> ShowS
Show, ReadPrec [YamlText]
ReadPrec YamlText
Int -> ReadS YamlText
ReadS [YamlText]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [YamlText]
$creadListPrec :: ReadPrec [YamlText]
readPrec :: ReadPrec YamlText
$creadPrec :: ReadPrec YamlText
readList :: ReadS [YamlText]
$creadList :: ReadS [YamlText]
readsPrec :: Int -> ReadS YamlText
$creadsPrec :: Int -> ReadS YamlText
Read, YamlText -> YamlText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YamlText -> YamlText -> Bool
$c/= :: YamlText -> YamlText -> Bool
== :: YamlText -> YamlText -> Bool
$c== :: YamlText -> YamlText -> Bool
Eq, Eq YamlText
YamlText -> YamlText -> Bool
YamlText -> YamlText -> Ordering
YamlText -> YamlText -> YamlText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: YamlText -> YamlText -> YamlText
$cmin :: YamlText -> YamlText -> YamlText
max :: YamlText -> YamlText -> YamlText
$cmax :: YamlText -> YamlText -> YamlText
>= :: YamlText -> YamlText -> Bool
$c>= :: YamlText -> YamlText -> Bool
> :: YamlText -> YamlText -> Bool
$c> :: YamlText -> YamlText -> Bool
<= :: YamlText -> YamlText -> Bool
$c<= :: YamlText -> YamlText -> Bool
< :: YamlText -> YamlText -> Bool
$c< :: YamlText -> YamlText -> Bool
compare :: YamlText -> YamlText -> Ordering
$ccompare :: YamlText -> YamlText -> Ordering
Ord)

-- a wrapper around Markdonw text
-- todo clean up - use wrap7
unYAML :: YamlText -> Text
unYAML :: YamlText -> Text
unYAML (YamlText Text
a) = Text
a --needed for other ops

extYAML :: Extension
extYAML :: Extension
extYAML = String -> Extension
Extension String
"yaml"

yamlFileType :: TypedFile5 Text YamlText

instance Zeros YamlText where zero :: YamlText
zero = Text -> YamlText
YamlText forall z. Zeros z => z
zero

yamlFileType :: TypedFile5 Text YamlText
yamlFileType = TypedFile5 {tpext5 :: Extension
tpext5 = Extension
extYAML} :: TypedFile5 Text YamlText

--instance FileHandles YamlText
-- what is missing here?

instance TypedFiles7 Text YamlText where
  -- handling Markdown and read them into YamlText
  wrap7 :: Text -> YamlText
wrap7 = Text -> YamlText
YamlText
  unwrap7 :: YamlText -> Text
unwrap7 (YamlText Text
a) = Text
a

readYaml2value :: Path Abs File -> ErrIO Value
-- read a yaml file to a value
-- error when syntax issue
readYaml2value :: Path Abs File -> ErrIO Value
readYaml2value Path Abs File
fp = do
  YamlText
t <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
fp TypedFile5 Text YamlText
yamlFileType
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs File -> YamlText -> Value
yaml2value Path Abs File
fp) forall a b. (a -> b) -> a -> b
$ YamlText
t

yaml2value :: Path Abs File -> YamlText -> Value
-- convert a YamlText to a JSON value, error if not ok
-- how to debug input erros?
yaml2value :: Path Abs File -> YamlText -> Value
yaml2value Path Abs File
fp YamlText
yt = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. [Text] -> a
errorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> [Text]
show2) forall a. a -> a
Prelude.id Either ParseException Value
vx
  where
    show2 :: ParseException -> [Text]
show2 ParseException
a =   [Text
"Yaml error in file (line count start 0)", forall {a}. Show a => a -> Text
showT Path Abs File
fp, Text
":", forall {a}. Show a => a -> Text
showT ParseException
a] 
    vx :: Either ParseException Value
vx = forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (Text -> ByteString
t2b forall b c a. (b -> c) -> (a -> b) -> a -> c
. YamlText -> Text
unYAML forall a b. (a -> b) -> a -> b
$ YamlText
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 :: forall a. (FromJSON a, Show a) => Path Abs File -> ErrIO a
readYaml2rec Path Abs File
fn = do 
    -- putIOwords [" yaml file name", showT fn ]
    -- settingsTxt <- read8 settingsfilename yamlFileType
    Value
s0 :: Value <- Path Abs File -> ErrIO Value
readYaml2value Path Abs File
fn 
    -- putIOwords ["yaml read", showPretty s0 ]

    a
s1  <-  forall a. (FromJSON a, Show a) => Value -> ErrIO a
fromJSONerrio  Value
s0  -- :: Result Settings 

    -- putIOwords ["json parsed", showT s1 ]

    forall (m :: * -> *) a. Monad m => a -> m a
return a
s1
-- for a test use readSettingsfile