packages feed

salak (empty) → 0.1.0

raw patch · 12 files changed

+608/−0 lines, 12 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bytestring, directory, filepath, hspec, scientific, split, text, unordered-containers, vector, yaml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Daniel YU (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel YU nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,5 @@+module Main where++main :: IO ()+main = do+  putStrLn "hello world"
+ README.md view
@@ -0,0 +1,1 @@+# salak
+ Setup.hs view
@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain
+ salak.cabal view
@@ -0,0 +1,96 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0f2d8453e74e53a24b06a57047e8a2cbff0554c3d8008c00c80746a3715498f6++name:           salak+version:        0.1.0+synopsis:       Configuration+description:    Configuration+category:       Library+homepage:       https://github.com/leptonyu/salak#readme+author:         Daniel YU+maintainer:     Daniel YU &lt;leptonyu@gmail.com&gt;+copyright:      (c) Daniel YU+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    README.md++library+  exposed-modules:+      Data.Salak+  other-modules:+      Data.Salak.Property+      Data.Salak.Environment+      Data.Salak.CommandLine+      Data.Salak.Aeson+      Data.Salak.Yaml+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , directory+    , filepath+    , scientific+    , split+    , text+    , unordered-containers+    , vector+    , yaml+  default-language: Haskell2010++executable salak+  main-is: Main.hs+  other-modules:+      Paths_salak+  hs-source-dirs:+      ./.+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , directory+    , filepath+    , scientific+    , split+    , text+    , unordered-containers+    , vector+    , yaml+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.Salak+      Data.Salak.Aeson+      Data.Salak.CommandLine+      Data.Salak.Environment+      Data.Salak.Property+      Data.Salak.Yaml+      Paths_salak+  hs-source-dirs:+      test+      src+  build-depends:+      QuickCheck+    , aeson+    , base >=4.7 && <5+    , bytestring+    , directory+    , filepath+    , hspec ==2.*+    , scientific+    , split+    , text+    , unordered-containers+    , vector+    , yaml+  default-language: Haskell2010
+ src/Data/Salak.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Salak(+    Property(..)+  , Properties(..)+  , Key+  , Return(..)+  , insert+  , toKeys+  , empty+  , lookup+  , makePropertiesFromEnvironment+  , defaultParseCommandLine+  , makePropertiesFromCommandLine+  , ParseCommandLine+  , makePropertiesFromJson+  , makePropertiesFromYaml+  , defaultProperties+  , defaultProperties'+  , defaultPropertiesWithFile+  , FileName+  ) where++import           Data.Maybe+import           Data.Salak.Aeson+import           Data.Salak.CommandLine+import           Data.Salak.Environment+import           Data.Salak.Property+import           Data.Salak.Yaml+import           Prelude                hiding (empty, lookup)+import           System.Directory+import           System.FilePath        ((</>))++defaultProperties :: IO Properties+defaultProperties = defaultProperties' defaultParseCommandLine++defaultProperties' :: ParseCommandLine -> IO Properties+defaultProperties' dpc+  = makePropertiesFromCommandLine dpc empty+  >>= makePropertiesFromEnvironment++type FileName = String++defaultPropertiesWithFile :: FileName -> IO Properties+defaultPropertiesWithFile name = do+  p <- defaultProperties+  let n  = fromMaybe name $ (lookup "salak.config.name" p :: Maybe String)+      p' = insert (toKeys "salak.config.name") (PStr n) p+  c <- getCurrentDirectory+  h <- getHomeDirectory+  foldl (go n) (return p') $ [(lookup "salak.config.dir" p, False), (Just c, True), (Just h, True)]+  where+    go _    p (Nothing, _) = p+    go name p (Just d, ok) = let f = d </> name in do+      p' <- p+      b <- doesFileExist f+      if b+        then makePropertiesFromYaml f p'+        else if ok then return p' else error $ "File " ++ f ++  " not found"
+ src/Data/Salak/Aeson.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Salak.Aeson where++import           Data.Aeson+import           Data.Char+import qualified Data.HashMap.Strict as M+import           Data.Maybe+import           Data.Salak.Property+import           Data.Text           (pack, unpack)+import           Data.Vector         (fromList, toList)++makePropertiesFromJson :: Value -> Properties -> Properties+makePropertiesFromJson Null       p = p+makePropertiesFromJson (Bool b)   p = insert [] (PBool b) p+makePropertiesFromJson (Number n) p = insert [] (PNum  n) p+makePropertiesFromJson (String s) p = insert [] (PStr  $ unpack s) p+makePropertiesFromJson (Array  v) (Node ps ms)  = let (nps,nms) = fromArray v in Node (ps++nps) (ms++nms)+makePropertiesFromJson (Object o) (Node ps [])  = Node ps [M.map jsonToProperties o]+makePropertiesFromJson (Object o) (Node ps [m]) = Node ps [m `M.union` M.map jsonToProperties o]+makePropertiesFromJson (Object o) p = p++jsonToProperties :: Value -> Properties+jsonToProperties = (`makePropertiesFromJson` empty)++fromArray v = foldl g3 ([],[]) $ go . jsonToProperties <$> toList v+  where+    go (Node ps ms) = (g2 ps,g2 ms)+    g2 []    = []+    g2 (a:_) = [a]+    g3 (as,bs) (a,b) = (as++a,bs++b)++instance FromProperties Value where+  fromProperties (Node []        []) = Empty+  fromProperties (Node [PBool p] []) = OK $ Bool p+  fromProperties (Node [PNum  p] []) = OK $ Number p+  fromProperties (Node [PStr  p] []) = OK $ String $ pack p+  fromProperties (Node ps [])        = OK $ Array $ fromList $ mapReturn (fromProperties.(\p-> Node [p] [])) ps+  fromProperties (Node _ [m])        = OK $ Object $ M.map (fromReturn Null . fromProperties) m+  fromProperties (Node _  ms)        = OK $ Array $ fromList $ mapReturn (fromProperties.(\m-> Node [] [m])) ms++instance {-# OVERLAPPABLE #-} FromJSON a => FromProperties a where+  fromProperties a = do+    v :: Value <- fromProperties a+    case fromJSON v of+      Success r -> OK r+      Error   e -> Fail e
+ src/Data/Salak/CommandLine.hs view
@@ -0,0 +1,24 @@+module Data.Salak.CommandLine where++import           Data.Char+import           Data.Maybe+import           Data.Salak.Property+import           System.Environment++type ParseCommandLine = [String] -> IO [(String,Property)]++defaultParseCommandLine :: ParseCommandLine+defaultParseCommandLine = return . mapMaybe go+  where+    go ('-':'-':as) = case break (=='=') as of+      (a,'=':b) -> Just (a,PStr b)+      _         -> Nothing+    go _ = Nothing++makePropertiesFromCommandLine :: ParseCommandLine -> Properties -> IO Properties+makePropertiesFromCommandLine parser p = getArgs >>= (\a -> makePropertiesFromCommandLine' a parser p)++makePropertiesFromCommandLine' :: [String] -> ParseCommandLine -> Properties -> IO Properties+makePropertiesFromCommandLine' args parser p = do+  v <- parser args+  return $ makeProperties v p
+ src/Data/Salak/Environment.hs view
@@ -0,0 +1,16 @@+module Data.Salak.Environment where++import           Data.Char+import           Data.Salak.Property+import           System.Environment++makePropertiesFromEnvironment :: Properties -> IO Properties+makePropertiesFromEnvironment p = getEnvironment >>= (\v -> return $ makePropertiesFromEnvironment' v p)+++makePropertiesFromEnvironment' :: [(String,String)] -> Properties -> Properties+makePropertiesFromEnvironment' vs = makeProperties $ go <$> vs+  where+    go (k,v) = (fmap g2 k,PStr v)+    g2 '_' = '.'+    g2 a   = toLower a
+ src/Data/Salak/Property.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Data.Salak.Property where++import           Control.Monad       ((>=>))+import           Data.Char+import qualified Data.HashMap.Strict as M+import           Data.Int+import           Data.List.Split+import           Data.Maybe+import           Data.Scientific+import           Data.Text           (Text, pack, unpack)+import           Data.Word+import           Foreign.C.Types+import           Text.Read++type Key = Text++data Properties+  = Node [Property] [M.HashMap Key Properties]+  deriving (Eq)++instance Show Properties where+  show = unlines . go ""+    where+      go p (Node ps ms) = fmap (g2 p) ps ++ concat (fmap (g3 p) ms)+      g2 p (PNum n)  = p ++ "=" ++ show n+      g2 p (PStr n)  = p ++ "=" ++ n+      g2 p (PBool n) = p ++ "=" ++ show n+      g3 :: String -> M.HashMap Key Properties -> [String]+      g3 p m = concat $ fmap (g4 p) $ M.toList m+      g4 "" (p2,ps) = go (unpack p2) ps+      g4 p  (p2,ps) = go (p ++ "." ++ unpack p2) ps++data Property+  = PNum  Scientific+  | PStr  String+  | PBool Bool+  deriving (Eq, Show)++empty :: Properties+empty = Node [] []++toKeys :: String -> [Key]+toKeys = fmap pack . filter (not.null) . splitOneOf "."++insert :: [Key] -> Property -> Properties -> Properties+insert []     p (Node [] m)  = Node [p] m+insert []     _ (Node ps m)  = Node ps  m+insert (a:as) p (Node ps []) = Node ps [M.insert a (insert as p empty) M.empty]+insert (a:as) p (Node ps ms) = Node ps $ go a as p <$> ms+  where+    go a as p m = case M.lookup a m of+      Just n  -> M.insert a (insert as p     n) m+      Nothing -> M.insert a (insert as p empty) m++lookup :: FromProperties a => String -> Properties -> Maybe a+lookup = go . toKeys+  where+    go []     p = from $ fromProperties p+    go (a:as) (Node _ [m]) = case M.lookup a m of+      Just n  -> go as n+      Nothing -> Nothing+    go (a:as) _ = Nothing++makeProperties :: [(String, Property)] -> Properties -> Properties+makeProperties ps m = foldl go m ps+  where+    go m (k,v) = insert (toKeys k) v m++data Return a+  = Empty+  | OK a+  | Fail String+  deriving Show++instance Functor Return where+  fmap f (OK a)   = OK (f a)+  fmap _ Empty    = Empty+  fmap _ (Fail b) = Fail b++instance Applicative Return where+  pure = OK+  (OK f) <*> (OK a) = OK (f a)+  (Fail x) <*> (Fail y) = Fail $ x ++ ";" ++ y+  (Fail x) <*> _ = Fail x+  _ <*> (Fail y) = Fail y+  _ <*> _ = Empty++instance Monad Return where+  (OK a)   >>= f = f a+  Empty    >>= _ = Empty+  (Fail b) >>= _ = Fail b++fromReturn :: b -> Return b -> b+fromReturn _ (OK a) = a+fromReturn a _      = a++mapReturn :: (a -> Return b) -> [a] -> [b]+mapReturn f as = go $ fmap f as+  where+    go []        = []+    go (OK a:as) = a : go as+    go (_:as)    = go as++class FromProperties a where+  fromProperties :: Properties -> Return a++instance FromProperties Property where+  fromProperties (Node (a:_) _) = OK a+  fromProperties _              = Empty++instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties [a] where+  fromProperties (Node ps ms) =+    let ns = fmap (\p -> Node [p] []) ps ++ fmap (\m -> Node [] [m]) ms+    in OK $ mapReturn fromProperties ns++instance FromProperties Scientific where+  fromProperties = fromProperties >=> go+    where+      go (PNum a) = OK a+      go (PStr a) = to readMaybe a+      go _        = Empty++instance FromProperties String where+  fromProperties = fromProperties >=> go+    where+      go (PStr a)  = OK a+      go (PNum a)  = OK $ show a+      go (PBool a) = OK $ toLower <$> show a++instance FromProperties Text where+  fromProperties a = pack <$> fromProperties a++instance FromProperties Float where+  fromProperties a = toRealFloat <$> fromProperties a++instance FromProperties Double where+  fromProperties a = toRealFloat <$> fromProperties a++instance FromProperties Int where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int8 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int16 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int32 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int64 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word8 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word16 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word32 where+  fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word64 where+  fromProperties = fromProperties >=> to toBoundedInteger++to :: (b -> Maybe a) -> b -> Return a+to v a = case v a of+  Just a  -> OK a+  Nothing -> Fail "number convert failed"++from :: Return a -> Maybe a+from (OK a)   = Just a+from Empty    = Nothing+from (Fail e) = error e++instance FromProperties Bool where+  fromProperties = fromProperties >=> go+    where+      go (PBool a) = OK a+      go (PStr  a) = g2 $ fmap toLower a+      go _         = Fail "number cannot convert to bool"+      g2 "true"  = OK True+      g2 "false" = OK False+      g2 _       = Empty++instance FromProperties Char where+  fromProperties = fromProperties >=> go+    where+      go (PStr (a:_)) = OK a+      go _            = Fail "cannot convert to char"++instance FromProperties CTime where+  fromProperties a = CTime <$> fromProperties a+
+ src/Data/Salak/Yaml.hs view
@@ -0,0 +1,10 @@+module Data.Salak.Yaml where++import           Data.Salak.Aeson+import           Data.Salak.Property+import           Data.Yaml++makePropertiesFromYaml :: FilePath -> Properties -> IO Properties+makePropertiesFromYaml file p = do+  v <- decodeFileThrow file+  return $ makePropertiesFromJson v p
+ test/Spec.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Exception      (SomeException)+import           Data.Aeson+import qualified Data.HashMap.Strict    as M+import           Data.Maybe+import           Data.Salak+import           Data.Salak.CommandLine+import           Data.Salak.Environment+import qualified Data.Salak.Property    as P+import           Data.Text              (Text, pack)+import           System.Environment+import           Test.Hspec++main = hspec spec++spec :: Spec+spec = do+  describe "Data.Salak.Property" specProperty++shouldFail :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation+shouldFail f a = (f `shouldBe` a) `shouldThrow` anyErrorCall++data Config = Config+  { name :: Text+  , dir  :: Text+  , ext  :: Int+  } deriving (Eq, Show)++instance FromJSON Config where+  parseJSON = withObject "Config" $ \v -> Config+        <$> v .: "name"+        <*> v .: "dir"+        <*> (fromMaybe 1 <$> v .:? "ext")++specProperty = do+  context "empty" $ do+    it "normal" $ do+      let p = empty+      print p+      p `shouldBe` Node [] []+  context "toKeys" $ do+    it "normal" $ do+      []        `shouldBe` toKeys ""+      ["a"]     `shouldBe` toKeys "a"+      ["a"]     `shouldBe` toKeys "a."+      ["a","b"] `shouldBe` toKeys "a.b"+      ["a","b"] `shouldBe` toKeys "a.....b"+  context "insert" $ do+    let p = PStr "Hello"+        k = toKeys "a.b"+        m = insert k p empty+    it "normal" $ do+      insert [] p empty `shouldBe` Node [p] []+      insert k  p empty `shouldBe` Node [] [M.insert "a" (Node [] [M.insert "b" (Node [p] []) M.empty]) M.empty]+    it "Reject replacement" $ do+      insert k (PStr "1") m `shouldBe` m+  context "lookup" $ do+    it "normal" $ do+      let m = insert ["a"] (PNum 1) empty+          n = insert ["a"] (PStr "true") empty+      (P.lookup "a" empty :: Maybe Int)    `shouldBe`   Nothing+      (P.lookup "a" m     :: Maybe Int)    `shouldBe`   Just  1+      (P.lookup "a" m     :: Maybe Bool)   `shouldFail` Nothing+      (P.lookup "a" m     :: Maybe String) `shouldBe`   Just "1.0"+      (P.lookup "a" n     :: Maybe Int)    `shouldFail` Nothing+      (P.lookup "a" n     :: Maybe Bool)   `shouldBe`   Just True+      (P.lookup "a" n     :: Maybe Text)   `shouldBe`   Just "true"+  context "makeProperties" $ do+    it "normal" $ do+      m <- makePropertiesFromEnvironment empty+      h <- getEnv "HOME"+      (P.lookup "home" m) `shouldBe` Just h+  context "command-line" $ do+    it "normal" $ do+      let args = ["--package.a.enabled=true","--package.b.enabled=false","package.c.enabled=false"]+      m    <- makePropertiesFromCommandLine' args defaultParseCommandLine empty+      P.lookup "package.a.enabled" m `shouldBe` Just True+      P.lookup "package.b.enabled" m `shouldBe` Just False+      (P.lookup "package.c.enabled" m :: Maybe Bool )`shouldBe` Nothing+  context "environment" $ do+    it "normal" $ do+      let args = [("PACKAGE_A_ENABLED","true"),("PACKAGE_B_ENABLED","false")]+          m    = makePropertiesFromEnvironment' args empty+      P.lookup "package.a.enabled" m `shouldBe` Just True+      P.lookup "package.b.enabled" m `shouldBe` Just False+      (P.lookup "package.c.enabled" m :: Maybe Bool )`shouldBe` Nothing+  context "defaultPropertiesWithFile" $ do+    let name = "salak.yml" :: String+    it "read config" $ do+      unsetEnv "SALAK_CONFIG_NAME"+      p <- defaultPropertiesWithFile name+      P.lookup "salak.config.name" p `shouldBe` Just name+    it "read config - replacement" $ do+      setEnv "SALAK_CONFIG_NAME" name+      p <- defaultPropertiesWithFile "salak.ok"+      P.lookup "salak.config.name" p `shouldBe` Just name+    it "read config - not found" $ do+      setEnv "SALAK_CONFIG_NAME" "salak.notfound"+      setEnv "SALAK_CONFIG_DIR" "test"+      defaultPropertiesWithFile name `shouldThrow` anyErrorCall+    it "read config - read file parse Config" $ do+      setEnv "SALAK_CONFIG_NAME" name+      setEnv "SALAK_CONFIG_DIR" "test"+      p <- defaultPropertiesWithFile name+      print p+      P.lookup "salak.config.name" p `shouldBe` Just name+      (P.lookup "salak.config" p :: Maybe Config) `shouldBe` Just (Config (pack name) "test" 1)+      (P.lookup "array" p :: Maybe [String]) `shouldBe` Just ["a","b"]++++