-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Properties file source
module Conferer.Source.PropertiesFile where

import Data.Text (Text)
import Data.Function ((&))
import System.Directory (doesFileExist)
import Data.Maybe (catMaybes)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import Conferer.Source
import Conferer.Source.Files
import qualified Conferer.Source.Null as Null
import qualified Conferer.Source.InMemory as InMemory

-- | 'Source' that uses a config file in @config/{env}.properties@ and
-- parses it as a properties file with @some.key=a value@ lines
data PropertiesFileSource =
  PropertiesFileSource
  { PropertiesFileSource -> FilePath
originalFilePath :: FilePath
  , PropertiesFileSource -> Source
innerSource :: Source
  } deriving (Int -> PropertiesFileSource -> ShowS
[PropertiesFileSource] -> ShowS
PropertiesFileSource -> FilePath
(Int -> PropertiesFileSource -> ShowS)
-> (PropertiesFileSource -> FilePath)
-> ([PropertiesFileSource] -> ShowS)
-> Show PropertiesFileSource
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PropertiesFileSource] -> ShowS
$cshowList :: [PropertiesFileSource] -> ShowS
show :: PropertiesFileSource -> FilePath
$cshow :: PropertiesFileSource -> FilePath
showsPrec :: Int -> PropertiesFileSource -> ShowS
$cshowsPrec :: Int -> PropertiesFileSource -> ShowS
Show)

instance IsSource PropertiesFileSource where
  getKeyInSource :: PropertiesFileSource -> Key -> IO (Maybe Text)
getKeyInSource PropertiesFileSource{FilePath
Source
innerSource :: Source
originalFilePath :: FilePath
innerSource :: PropertiesFileSource -> Source
originalFilePath :: PropertiesFileSource -> FilePath
..} Key
key = do
    Source -> Key -> IO (Maybe Text)
forall s. IsSource s => s -> Key -> IO (Maybe Text)
getKeyInSource Source
innerSource Key
key
  getSubkeysInSource :: PropertiesFileSource -> Key -> IO [Key]
getSubkeysInSource PropertiesFileSource{FilePath
Source
innerSource :: Source
originalFilePath :: FilePath
innerSource :: PropertiesFileSource -> Source
originalFilePath :: PropertiesFileSource -> FilePath
..} Key
key = do
    Source -> Key -> IO [Key]
forall s. IsSource s => s -> Key -> IO [Key]
getSubkeysInSource Source
innerSource Key
key

-- | Create a 'SourceCreator' using 'getFilePathFromEnv' to get the path to file
-- and 'fromFilePath'
fromConfig :: Key -> SourceCreator
fromConfig :: Key -> SourceCreator
fromConfig Key
key Config
config = do
  FilePath
filePath <- Key -> FilePath -> Config -> IO FilePath
getFilePathFromEnv Key
key FilePath
"properties" Config
config
  FilePath -> IO Source
fromFilePath' FilePath
filePath

-- | Create a 'SourceCreator' reading the file and using that as a properties file, but
-- if the file doesn't exist do nothing.
fromFilePath :: FilePath -> SourceCreator
fromFilePath :: FilePath -> SourceCreator
fromFilePath FilePath
filepath Config
_config =
  FilePath -> IO Source
fromFilePath' FilePath
filepath

-- | Create a 'Source' reading the file and using that as a properties file, but
-- if the file doesn't exist do nothing.
fromFilePath' :: FilePath -> IO Source
fromFilePath' :: FilePath -> IO Source
fromFilePath' FilePath
filePath = do
  Bool
fileExists <- FilePath -> IO Bool
doesFileExist FilePath
filePath
  if Bool
fileExists
    then do
      Text
fileContent <- FilePath -> IO Text
Text.readFile FilePath
filePath
      Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Source
fromFileContent FilePath
filePath Text
fileContent
    else
      Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return Source
Null.empty

-- | Create a 'Source' using some content as a properties file
fromFileContent :: FilePath -> Text -> Source
fromFileContent :: FilePath -> Text -> Source
fromFileContent FilePath
originalFilePath Text
fileContent =
  let keyValues :: [(Key, Text)]
keyValues =
        Text
fileContent
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text]
Text.lines
        [Text] -> ([Text] -> [Maybe (Key, Text)]) -> [Maybe (Key, Text)]
forall a b. a -> (a -> b) -> b
& (Text -> Maybe (Key, Text)) -> [Text] -> [Maybe (Key, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe (Key, Text)
lineToKeyValue
        [Maybe (Key, Text)]
-> ([Maybe (Key, Text)] -> [(Key, Text)]) -> [(Key, Text)]
forall a b. a -> (a -> b) -> b
& [Maybe (Key, Text)] -> [(Key, Text)]
forall a. [Maybe a] -> [a]
catMaybes
      innerSource :: Source
innerSource = [(Key, Text)] -> Source
InMemory.fromAssociations [(Key, Text)]
keyValues
  in PropertiesFileSource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source (PropertiesFileSource -> Source) -> PropertiesFileSource -> Source
forall a b. (a -> b) -> a -> b
$ PropertiesFileSource :: FilePath -> Source -> PropertiesFileSource
PropertiesFileSource {FilePath
Source
innerSource :: Source
originalFilePath :: FilePath
innerSource :: Source
originalFilePath :: FilePath
..}

-- | Transform a line into a key/value pair (or not)
lineToKeyValue :: Text -> Maybe (Key, Text)
lineToKeyValue :: Text -> Maybe (Key, Text)
lineToKeyValue Text
line =
  Text -> Text -> (Text, Text)
Text.breakOn Text
"=" Text
line
  (Text, Text)
-> ((Text, Text) -> Maybe (Key, Text)) -> Maybe (Key, Text)
forall a b. a -> (a -> b) -> b
& (\(Text
rawKey, Text
rawValue) ->
      case Text -> Text -> Maybe Text
Text.stripPrefix Text
"=" Text
rawValue of
        Just Text
value ->
          (Key, Text) -> Maybe (Key, Text)
forall a. a -> Maybe a
Just (Text -> Key
fromText Text
rawKey, Text
value)
        Maybe Text
Nothing ->
          Maybe (Key, Text)
forall a. Maybe a
Nothing
    )