salak 0.2.9 → 0.2.9.1
raw patch · 7 files changed
+177/−12 lines, 7 filesdep +bytestring
Dependencies added: bytestring
Files
- README.md +1/−0
- salak.cabal +3/−1
- src/Salak.hs +2/−0
- src/Salak/Prop.hs +166/−10
- src/Salak/Types.hs +2/−1
- src/Salak/Types/Source.hs +1/−0
- test/Spec.hs +2/−0
README.md view
@@ -96,3 +96,4 @@ TODO: - Add git pull support. - Add automatic reloading.+- Add FromProp instance of Time.
salak.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.2.9+version: 0.2.9.1 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -31,6 +31,7 @@ build-depends: attoparsec >=0.13.2.2 && <0.14, base >=4.10 && <5,+ bytestring >=0.10.8.2 && <0.11, containers >=0.6.0.1 && <0.7, data-default >=0.7.1.1 && <0.8, directory >=1.3.3.0 && <1.4,@@ -63,6 +64,7 @@ QuickCheck >=2.12.6.1 && <2.14, attoparsec >=0.13.2.2 && <0.14, base >=4.10 && <5,+ bytestring >=0.10.8.2 && <0.11, containers >=0.6.0.1 && <0.7, data-default >=0.7.1.1 && <0.8, directory >=1.3.3.0 && <1.4,
src/Salak.hs view
@@ -52,6 +52,8 @@ , Prop , FromProp(..) , FromEnumProp(..)+ , readPrimitive+ , PResult(..) , (.?=) , (.?:) ) where
src/Salak/Prop.hs view
@@ -8,29 +8,36 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} module Salak.Prop where import Control.Applicative+import Control.Monad.Identity import Control.Monad.Reader+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import Data.Default import Data.Int-import qualified Data.Map.Strict as M+import qualified Data.Map.Strict as M import Data.Menshen import Data.Scientific-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import Data.Semigroup+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TB+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TBL+import Data.Time import Data.Word+import Foreign.C import GHC.Exts-import GHC.Generics hiding (Selector)-import qualified GHC.Generics as G+import GHC.Generics hiding (Selector)+import qualified GHC.Generics as G import Salak.Types import Salak.Types.Selector import Salak.Types.Source import Salak.Types.Value-import Text.Read (readMaybe)+import Text.Read (readMaybe) data PResult a = O [Selector] a -- ^ Succeed value@@ -79,6 +86,7 @@ -- | Monad used to parse properties to destination type. type Prop = PropT PResult +runProp :: PropSource -> PropT m a -> m a runProp sp a = runReaderT (unProp a) sp askSub :: (SourcePack -> SourcePack) -> Prop PropSource@@ -113,6 +121,7 @@ | otherwise = fmap M1 $ gEnum $ T.pack (conName m) where m = undefined :: t c a x +gEnum :: GFromProp f => Text -> PropT PResult (f a) gEnum va = do o <- gFromProp readPrimitive $ \ss v -> case v of@@ -147,6 +156,41 @@ N s -> O s Nothing F s e -> F s e +instance FromProp a => FromProp (Either String a) where+ fromProp = do+ fps <- askSub id+ lift $ case runProp fps (fromProp :: Prop a) of+ O s a -> O s $ Right a+ N s -> O s $ Left "null"+ F s e -> O s $ Left e++instance FromProp a => FromProp (Identity a) where+ fromProp = Identity <$> fromProp++instance (FromProp a, FromProp b) => FromProp (a,b) where+ fromProp = (,) <$> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c) => FromProp (a,b,c) where+ fromProp = (,,) <$> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d) => FromProp (a,b,c,d) where+ fromProp = (,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d, FromProp e) => FromProp (a,b,c,d,e) where+ fromProp = (,,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d, FromProp e, FromProp f) => FromProp (a,b,c,d,e,f) where+ fromProp = (,,,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d, FromProp e, FromProp f, FromProp g) => FromProp (a,b,c,d,e,f,g) where+ fromProp = (,,,,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d, FromProp e, FromProp f, FromProp g, FromProp h) => FromProp (a,b,c,d,e,f,g,h) where+ fromProp = (,,,,,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp++instance (FromProp a, FromProp b, FromProp c, FromProp d, FromProp e, FromProp f, FromProp g, FromProp h, FromProp i) => FromProp (a,b,c,d,e,f,g,h,i) where+ fromProp = (,,,,,,,,) <$> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp <*> fromProp+ instance {-# OVERLAPPABLE #-} FromProp a => FromProp [a] where fromProp = do sp@SourcePack{..} <- ask@@ -154,10 +198,34 @@ return (reverse as) where go sp' as (ix,s) = do- so <- askSub $ \_ -> sp' { prefix = ix : prefix sp', source = s}+ so <- askSub $ const sp' { prefix = ix : prefix sp', source = s} a <- lift $ runProp so fromProp return (a:as) +instance FromProp a => FromProp (Min a) where+ fromProp = Min <$> fromProp++instance FromProp a => FromProp (Max a) where+ fromProp = Max <$> fromProp++instance FromProp a => FromProp (First a) where+ fromProp = First <$> fromProp++instance FromProp a => FromProp (Last a) where+ fromProp = Last <$> fromProp++instance FromProp a => FromProp (Dual a) where+ fromProp = Dual <$> fromProp++instance FromProp a => FromProp (Sum a) where+ fromProp = Sum <$> fromProp++instance FromProp a => FromProp (Product a) where+ fromProp = Product <$> fromProp++instance FromProp a => FromProp (Option a) where+ fromProp = Option <$> fromProp+ instance {-# OVERLAPPABLE #-} FromEnumProp a => FromProp a where fromProp = readPrimitive $ \ss v -> case v of VStr _ s -> either (F ss) (O ss) $ fromEnumProp $ T.toLower s@@ -166,7 +234,7 @@ evalV :: [Selector] -> Value -> Prop Value evalV x (VRef i rs) = do sp <- askOrigin- ps <- askSub (\_ -> sp)+ ps <- askSub (const sp) if M.member x (cacheRef ps) then lift $ F x "self reference" else lift $ VStr i <$> foldM (go ps { cacheRef = M.insert x True $ cacheRef ps} ) "" rs@@ -232,6 +300,12 @@ instance FromProp TL.Text where fromProp = TL.fromStrict <$> fromProp +instance FromProp B.ByteString where+ fromProp = TB.encodeUtf8 <$> fromProp++instance FromProp BL.ByteString where+ fromProp = TBL.encodeUtf8 <$> fromProp+ instance FromProp String where fromProp = T.unpack <$> fromProp @@ -250,6 +324,9 @@ instance FromProp Double where fromProp = toRealFloat <$> fromProp +instance FromProp Integer where+ fromProp = toInteger <$> (fromProp :: Prop Int)+ instance FromProp Int where fromProp = fromProp >>= toNum @@ -280,7 +357,86 @@ instance FromProp Word64 where fromProp = fromProp >>= toNum +instance FromProp NominalDiffTime where+ fromProp = fromInteger <$> fromProp++instance FromProp DiffTime where+ fromProp = timeOfDayToTime <$> fromProp+ toNum :: (Integral i, Bounded i) => Scientific -> Prop i toNum s = case toBoundedInteger s of Just v -> return v _ -> err "scientific number doesn't fit in the target representation"++instance FromProp UTCTime where+ fromProp = readPrimitive go+ where+ go s (VZTime _ a b) = O s (zonedTimeToUTC $ ZonedTime b a)+ go s x = F s $ getType x ++ " cannot be UTCTime"++instance FromProp ZonedTime where+ fromProp = readPrimitive go+ where+ go s (VZTime _ a b) = O s (ZonedTime b a)+ go s x = F s $ getType x ++ " cannot be ZonedTime"++instance FromProp LocalTime where+ fromProp = readPrimitive go+ where+ go s (VLTime _ b) = O s b+ go s (VZTime _ _ b) = O s b+ go s x = F s $ getType x ++ " cannot be LocalTime"++instance FromProp Day where+ fromProp = readPrimitive go+ where+ go s (VDay _ b) = O s b+ go s (VLTime _ b) = O s (localDay b)+ go s x = F s $ getType x ++ " cannot be Day"++instance FromProp TimeOfDay where+ fromProp = readPrimitive readTimeOfDay++readTimeOfDay s (VHour _ b) = O s b+readTimeOfDay s (VLTime _ b) = O s (localTimeOfDay b)+readTimeOfDay s x = F s $ getType x ++ " cannot be TimeOfDay"++instance FromProp CBool where+ fromProp = do+ b <- fromProp+ return $ if b then 1 else 0++instance FromProp CShort where+ fromProp = CShort <$> fromProp++instance FromProp CUShort where+ fromProp = CUShort <$> fromProp++instance FromProp CInt where+ fromProp = CInt <$> fromProp++instance FromProp CUInt where+ fromProp = CUInt <$> fromProp++instance FromProp CLong where+ fromProp = CLong <$> fromProp++instance FromProp CULong where+ fromProp = CULong <$> fromProp++instance FromProp CLLong where+ fromProp = CLLong <$> fromProp++instance FromProp CULLong where+ fromProp = CULLong <$> fromProp++instance FromProp CFloat where+ fromProp = CFloat <$> fromProp++instance FromProp CDouble where+ fromProp = CDouble <$> fromProp+++++
src/Salak/Types.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-} module Salak.Types where import Control.Monad.State@@ -29,6 +28,7 @@ where go SourcePack{..} = (errs, source) +emptyReload :: String -> Reload emptyReload s = defReload s (return ()) -- | Source package, used to store all properties.@@ -40,6 +40,7 @@ , errs :: [String] } deriving Show +emptySourcePack :: SourcePack emptySourcePack = SourcePack [] 0 emptySource mempty [] mapSource :: (Source -> Source) -> SourcePack -> SourcePack
src/Salak/Types/Source.hs view
@@ -58,6 +58,7 @@ updateSources :: Monad m => [Selector] -> (Source -> m Source) -> Source -> m Source updateSources = flip (foldr updateSource) +replace :: Priority -> Source -> Source -> Writer [String] Source replace = replace' [] replace' :: [Selector] -> Priority -> Source -> Source -> Writer [String] Source
test/Spec.hs view
@@ -21,6 +21,7 @@ import Test.Hspec import Test.QuickCheck +main :: IO () main = hspec spec spec :: Spec@@ -56,6 +57,7 @@ instance FromProp Conf +specProperty :: SpecWith () specProperty = do context "selectors" $ do it "normal" $ do