salak-toml 0.2.10 → 0.3

raw patch · 3 files changed

+73/−54 lines, 3 filesdep +exceptionsdep ~basedep ~salakPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: base, salak

API changes (from Hackage documentation)

Files

• salak-toml.cabal +4/−4
• src/Salak/Toml.hs +56/−43
• test/Spec.hs +13/−7

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-toml-version: 0.2.10+version: 0.3 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -24,8 +24,7 @@     ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures     build-depends:         base >=4.10 && <5,-        mtl >=2.2.2 && <2.3,-        salak >=0.2.10 && <0.3,+        salak ==0.3.*,         text >=1.2.3.1 && <1.3,         time >=1.8.0.2 && <1.9,         tomland >=1.0 && <1.2,@@ -43,9 +42,10 @@     build-depends:         QuickCheck >=2.13.2 && <2.14,         base >=4.10 && <5,+        exceptions >=0.10.2 && <0.11,         hspec ==2.*,         mtl >=2.2.2 && <2.3,-        salak >=0.2.10 && <0.3,+        salak ==0.3.*,         text >=1.2.3.1 && <1.3,         time >=1.8.0.2 && <1.9,         tomland >=1.0 && <1.2,

@@ -1,6 +1,8 @@-{-# LANGUAGE GADTs           #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections   #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE NoOverloadedLists #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TupleSections     #-} -- | -- Module:      Salak.Toml -- Copyright:   (c) 2019 Daniel YU@@ -14,63 +16,74 @@ module Salak.Toml(     TOML(..)   , loadToml+  , runSalakWithToml   ) where -import           Control.Monad          (foldM, (>=>))-import           Control.Monad.IO.Class (MonadIO, liftIO)-import           Control.Monad.Writer-import qualified Data.HashMap.Strict    as HM-import qualified Data.List.NonEmpty     as N-import qualified Data.Text.IO           as IO+import           Control.Exception   (Exception, throwIO)+import qualified Data.HashMap.Strict as HM+import qualified Data.List.NonEmpty  as N+import           Data.Text           (Text)+import qualified Data.Text.IO        as IO import           Data.Time import           Salak-import           Salak.Load-import           Toml                   hiding (TOML)-import qualified Toml                   as T+import           Salak.Internal+import qualified Salak.Trie          as TR+import           Toml                hiding (Key, TOML, Value)+import qualified Toml                as T ++runSalakWithToml :: (MonadCatch m, MonadIO m) => FilePath -> RunSalakT m a -> m a+runSalakWithToml name = runSalakWith name TOML+ -- | TOML notation for `loadToml` data TOML = TOML  instance HasLoad TOML where   loaders _ = (, loadToml) <$> ["toml", "tml"] -toSs :: Key -> [Selector]-toSs (Key ps) = toS <$> N.toList ps+toSs :: T.Key -> [Key]+toSs (T.Key ps) = toS <$> N.toList ps -toS :: Piece -> Selector-toS = SStr . unPiece+toS :: Piece -> Key+toS = KT . unPiece -loadTOML :: Monad m => T.TOML -> Priority -> Source -> WriterT [String] m Source-loadTOML T.TOML{..} i = foldPairs       tomlPairs-                    >=> foldTables      tomlTables-                    >=> foldTableArrays tomlTableArrays+loadTOML :: Int -> T.TOML -> TraceSource -> TraceSource+loadTOML i T.TOML{..}+  = foldPairs       tomlPairs+  . foldTables      tomlTables+  . foldTableArrays tomlTableArrays   where-    foldToml go m s = HM.foldlWithKey' (\ms k v -> ms >>= go k v) (return s) m-    foldPairs       = foldToml (\k -> updateSources (toSs k) . insertAnyValue i)-    foldTables      = foldToml (const go)+    foldToml go p t = HM.foldlWithKey' go t p+    foldPairs       = foldToml (\s k v -> TR.modify' (Keys $ toSs k) (insertAnyValue i v) s)+    foldTableArrays = foldToml (\s _ v -> foldArray (N.toList v) (loadTOML i) s)+    foldTables      = foldToml (\s _ v -> go v s)       where-        go (Leaf   k     toml) = updateSources (toSs k) (loadTOML toml i)-        go (Branch k v' tomap) = updateSources (toSs k) (maybe return (`loadTOML` i) v' >=> foldTables tomap)-    foldTableArrays = foldToml (\k v -> updateSources (toSs k) (foldArray (N.toList v) (`loadTOML` i)))+        go (Leaf   k toml)    = TR.modify' (Keys $ toSs k) (loadTOML i toml)+        go (Branch k v tomap) = TR.modify' (Keys $ toSs k) (foldTables tomap) . maybe id (loadTOML i) v+insertAnyValue :: Int -> AnyValue -> TraceSource -> TraceSource+insertAnyValue i (AnyValue (Array   b))             ts = foldArray b (insertAnyValue i . AnyValue) ts+insertAnyValue i (AnyValue (Bool    b))             ts = setVal i (VB  b) ts+insertAnyValue i (AnyValue (Integer b))             ts = setVal i (VI $ fromIntegral b) ts+insertAnyValue i (AnyValue (Double  b))             ts = setVal i (VI $ realToFrac   b) ts+insertAnyValue i (AnyValue (Text    b))             ts = setVal i (VT  b) ts+insertAnyValue i (AnyValue (Local   b))             ts = setVal i (VLT b) ts+insertAnyValue i (AnyValue (Day     b))             ts = setVal i (VD  b) ts+insertAnyValue i (AnyValue (Hours   b))             ts = setVal i (VH  b) ts+insertAnyValue i (AnyValue (Zoned (ZonedTime a b))) ts = setVal i (VZT b a) ts -insertAnyValue :: Monad m => Priority -> AnyValue -> Source -> m Source-insertAnyValue i (AnyValue (Array   b))             = foldArray b (insertAnyValue i . AnyValue)-insertAnyValue i (AnyValue (Bool    b))             = return . insertSource (VBool  i b)-insertAnyValue i (AnyValue (Integer b))             = return . insertSource (VNum   i $ fromIntegral b)-insertAnyValue i (AnyValue (Double  b))             = return . insertSource (VNum   i $ realToFrac b)-insertAnyValue i (AnyValue (Text    b))             = return . insertSource (newVStr  b i)-insertAnyValue i (AnyValue (Local   b))             = return . insertSource (VLTime i b)-insertAnyValue i (AnyValue (Day     b))             = return . insertSource (VDay   i b)-insertAnyValue i (AnyValue (Hours   b))             = return . insertSource (VHour  i b)-insertAnyValue i (AnyValue (Zoned (ZonedTime a b))) = return . insertSource (VZTime i b a)+foldArray :: [a] -> (a -> TraceSource -> TraceSource) -> TraceSource -> TraceSource+foldArray as f ts = foldl go ts $ zip [0..] as+  where+    go t (i, a) = TR.modify (KI i) (f a) t -foldArray :: Monad m => [a] -> (a -> Source -> m Source) -> Source -> m Source-foldArray a g s = foldM (\s' (ix,x) -> updateSource (SNum ix) (g x) s') s $ zip [0..] a+newtype TomlException = TomlException Text deriving Show +instance Exception TomlException+ -- | Load Toml-loadToml :: MonadIO m => FilePath -> LoadSalakT m ()-loadToml file = load file $ \i s -> do-  re <- liftIO (parse <$> IO.readFile file)+loadToml :: FilePath -> LoadSalak ()+loadToml file = loadTrie True file $ \i -> do+  re <- T.parse <$> IO.readFile file   case re of-      Left  e -> tell [show e] >> return s-      Right a -> loadTOML a i s+      Left  (T.ParseException e) -> throwIO (TomlException e)+      Right a                    -> return  (loadTOML i a TR.empty)

@@ -1,16 +1,21 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}  module Main where +import           Control.Monad.Catch import           Control.Monad.Reader import           Data.List            (intercalate) import           Data.Text            (Text, pack) import           GHC.Generics import           Salak+import           Salak.Internal import           Salak.Toml import           Test.Hspec import           Test.QuickCheck@@ -46,16 +51,17 @@ data SubConf = SubConf   { hello :: String } deriving (Eq, Show, Generic) -instance FromProp SubConf where+instance MonadCatch m => FromProp m SubConf where   fromProp = SubConf <$> "hello" .?= "yyy" -instance FromProp Conf+instance MonadCatch m => FromProp m Conf  tomlProperty :: SpecWith () tomlProperty = do   context "load toml" $ do     it "salak.toml" $ do       loadAndRunSalak (loadToml "test/salak.toml") $ do+        SourcePack{..}  <- askSalak         cf <- require "me.icymint.conf"         lift $ do           name cf `shouldBe` "shelly"