initial

.gitignore

@@ -0,0 +1,20 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+.HTF/

CHANGELOG.md

@@ -0,0 +1,12 @@
+# Changelog
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
+and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
+
+## [Unreleased]
+
+## [0.1.0.0] - 2018-01-22
+### Added
+- `GetConfig` class with method `getConfig`
+- Instances for FileSystem, Mongo, Mysql, Neo4j, Postgres, Redis, Schrodinger

README.md

@@ -0,0 +1,10 @@
+# bcd-config
+
+Tiny library with configs for:
+* FileSystem;
+* Mongo;
+* Mysql;
+* Neo4j;
+* Postgres;
+* Redis;
+* Schrodinger.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

bcd-config.cabal

@@ -0,0 +1,38 @@
+name:           bcd-config
+version:        0.1.0.0
+description:    Library to get config to different systems
+homepage:       https://github.com/biocad/bcd-config#readme
+bug-reports:    https://github.com/biocad/bcd-config/issues
+author:         Bogdan Neterebskii
+maintainer:     [email protected]
+copyright:      (c) 2018, Bogdan Neterebskii
+stability:      experimental
+category:       System
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+
+extra-source-files:
+    CHANGELOG.md
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/biocad/bcd-config
+
+library
+  hs-source-dirs:   src
+  exposed-modules:  System.BCD.Config
+                  , System.BCD.Config.Mongo
+                  , System.BCD.Config.Neo4j
+                  , System.BCD.Config.Redis
+                  , System.BCD.Config.Mysql
+                  , System.BCD.Config.Postgres
+                  , System.BCD.Config.Schrodinger
+                  , System.BCD.Config.FileSystem
+  build-depends:    base >=4.7 && <5
+                  , text
+                  , unordered-containers
+                  , aeson-picker
+  default-language: Haskell2010

src/System/BCD/Config.hs

@@ -0,0 +1,43 @@
+module System.BCD.Config
+  ( GetConfig (..)
+  , getConfigText
+  ) where
+
+import           Control.Applicative ((<|>))
+import           Data.List           (find, isPrefixOf)
+import           Data.Maybe          (fromJust)
+import           Data.Text           (Text)
+import           Data.Text.IO        (readFile)
+import           Prelude             hiding (readFile)
+import           System.Environment  (getArgs)
+
+class GetConfig a where
+  getConfig :: IO a
+
+{-|
+  The 'getConfig' function returns 'Text' in 'IO' monad with content of JSON file with config.
+  More information on JSON config file convention is availeble here:
+  <https://api.biocad.ru/Infrastructure/%D0%9A%D0%BE%D0%BD%D0%B2%D0%B5%D0%BD%D1%86%D0%B8%D0%B8/config.json>
+
+  This function will looks for config file with such params:
+  @
+  ./some-application --config-file=/path/to/config.json
+  ./some-application -f /path/to/config.json
+  @
+  By default it is looking for @config.json@ in current directory.
+-}
+getConfigText :: IO Text
+getConfigText = do
+    args <- getArgs
+    let path = fromJust $ findLong args <|> findShort args <|> Just "config.json"
+    readFile path
+  where
+    longArg = "--config-file="
+
+    findLong :: [String] -> Maybe FilePath
+    findLong args = drop (length longArg) <$> find (longArg `isPrefixOf`) args
+
+    findShort :: [String] -> Maybe FilePath
+    findShort ("-f":xs) = pure . head $ xs
+    findShort (_:xs)    = findShort xs
+    findShort _         = Nothing

src/System/BCD/Config/FileSystem.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.FileSystem
+  ( FileSystemConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker   ((|--))
+import           Data.HashMap.Strict (HashMap)
+import           System.BCD.Config   (GetConfig (..), getConfigText)
+
+newtype FileSystemConfig = FileSystemConfig (HashMap String FilePath)
+  deriving (Show, Read, Eq)
+
+instance GetConfig FileSystemConfig where
+  getConfig = do
+      jsonText <- getConfigText    
+      let fs = jsonText |-- ["deploy", "fs"]
+      pure $ FileSystemConfig fs

src/System/BCD/Config/Mongo.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Mongo
+  ( MongoConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker   ((|--))
+import           System.BCD.Config   (GetConfig (..), getConfigText)
+
+data MongoConfig = MongoConfig { _host     :: String
+                               , _port     :: Int
+                               , _user     :: String
+                               , _password :: String
+                               , _descr    :: String
+                               }
+  deriving (Show, Read, Eq)
+
+instance GetConfig MongoConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "mongo", field]
+      pure $ MongoConfig (get "host")
+                         (get "port")
+                         (get "user")
+                         (get "password")
+                         (get "descr")

src/System/BCD/Config/Mysql.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Mysql
+  ( MysqlConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker   ((|--))
+import           System.BCD.Config   (GetConfig (..), getConfigText)
+
+data MysqlConfig = MysqlConfig { _host     :: String
+                               , _port     :: Int
+                               , _user     :: String
+                               , _password :: String
+                               , _descr    :: String
+                               }
+  deriving (Show, Read, Eq)
+
+instance GetConfig MysqlConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "mysql", field]
+      pure $ MysqlConfig (get "host")
+                         (get "port")
+                         (get "user")
+                         (get "password")
+                         (get "descr")

src/System/BCD/Config/Neo4j.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Neo4j
+  ( Neo4jConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker ((|--))
+import           System.BCD.Config (GetConfig (..), getConfigText)
+
+data Neo4jConfig = Neo4jConfig { _host     :: String
+                               , _port     :: Int
+                               , _user     :: String
+                               , _password :: String
+                               , _stripes  :: Int
+                               , _timeout  :: Int
+                               , _rps      :: Int
+                               , _descr    :: String
+                               }
+  deriving (Show, Read, Eq)
+
+instance GetConfig Neo4jConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "neo4j", field]
+      pure $ Neo4jConfig (get "host")
+                         (get "port")
+                         (get "user")
+                         (get "password")
+                         (get "stripes")
+                         (get "timeout")
+                         (get "rps")
+                         (get "descr")

src/System/BCD/Config/Postgres.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Postgres
+  ( PostgresConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker   ((|--))
+import           System.BCD.Config   (GetConfig (..), getConfigText)
+
+data PostgresConfig = PostgresConfig { _host     :: String
+                                     , _port     :: Int
+                                     , _user     :: String
+                                     , _password :: String
+                                     , _descr    :: String
+                                     }
+  deriving (Show, Read, Eq)
+
+instance GetConfig PostgresConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "postgres", field]
+      pure $ PostgresConfig (get "host")
+                            (get "port")
+                            (get "user")
+                            (get "password")
+                            (get "descr")

src/System/BCD/Config/Redis.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Redis
+  ( RedisConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker ((|--))
+import           System.BCD.Config (GetConfig (..), getConfigText)
+
+data RedisConfig = RedisConfig { _host     :: String
+                               , _port     :: Int
+                               , _user     :: String
+                               , _password :: String
+                               , _descr    :: String
+                               }
+  deriving (Show, Read, Eq)
+
+
+instance GetConfig RedisConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "redis", field]
+      pure $ RedisConfig (get "host")
+                         (get "port")
+                         (get "user")
+                         (get "password")
+                         (get "descr")

src/System/BCD/Config/Schrodinger.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.BCD.Config.Schrodinger
+  ( SchrodingerConfig (..)
+  , GetConfig (..)
+  ) where
+
+import           Data.Aeson.Picker ((|--))
+import           System.BCD.Config (GetConfig (..), getConfigText)
+
+data SchrodingerConfig = SchrodingerConfig { _host     :: String
+                                           , _port     :: Int
+                                           , _user     :: String
+                                           , _password :: String
+                                           }
+  deriving (Show, Read, Eq)
+
+instance GetConfig SchrodingerConfig where
+  getConfig = do
+      jsonText <- getConfigText
+      let get field = jsonText |-- ["deploy", "schrodinger", field]
+      pure $ SchrodingerConfig (get "host")
+                               (get "port")
+                               (get "user")
+                               (get "password")

stack.yaml

@@ -0,0 +1,26 @@
+# before building, don`t forget to delete the cache file ~/.stack/custom-plan/yaml/
+
+resolver: https://lts.math.bio/bcd-lts-dev.yaml
+
+package-indices:
+- name: LTS-index
+  download-prefix: https://hackage.math.bio/hackage.fpcomplete.com/package/
+  http: https://hackage.math.bio/hackage.fpcomplete.com/00-index.tar.gz
+- name: Hackage Biocad
+  download-prefix: http://hackage.biocad.ru/package/
+  http: http://hackage.biocad.ru/00-index.tar.gz
+
+# package and necessary repos that are not included in the BCD-LTS
+packages:
+- '.'
+
+# necessary extra-deps that are not included in the BCD-LTS
+extra-deps:
+- aeson-picker-0.1.0.1
+
+# https://github.com/commercialhaskell/stack/issues/3520
+ignore-revision-mismatch: true
+
+flags: {}
+
+extra-package-dbs: []