{-# LANGUAGE BangPatterns #-}

-- |
-- Integration between the LaunchDarkly SDK and file data.
--
--  The file data source allows you to use local files as a source of feature
--  flag state. This would typically be used in a test environment, to operate
--  using a predetermined feature flag state without an actual LaunchDarkly
--  connection. See 'dataSourceFactory' for details.
--
--  @since 2.2.1
module LaunchDarkly.Server.Integrations.FileData
    ( dataSourceFactory
    )
where

import Control.Applicative ((<|>))
import Data.Aeson (FromJSON, Value, decode)
import qualified Data.ByteString.Lazy as BSL
import Data.Generics.Product (getField)
import Data.HashSet (HashSet)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Yaml as Yaml
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import LaunchDarkly.AesonCompat (KeyMap, mapWithKey)
import LaunchDarkly.Server.Client.Status
import LaunchDarkly.Server.DataSource.Internal (DataSource (..), DataSourceFactory, DataSourceUpdates (..))
import qualified LaunchDarkly.Server.Features as F

data FileFlag = FileFlag
    { FileFlag -> Maybe Natural
version :: Maybe Natural
    , FileFlag -> Maybe Bool
on :: Maybe Bool
    , FileFlag -> Maybe [Target]
targets :: Maybe [F.Target]
    , FileFlag -> Maybe [Target]
contextTargets :: Maybe [F.Target]
    , FileFlag -> Maybe [Rule]
rules :: Maybe [F.Rule]
    , FileFlag -> Maybe VariationOrRollout
fallthrough :: Maybe F.VariationOrRollout
    , FileFlag -> Maybe Integer
offVariation :: Maybe Integer
    , FileFlag -> [Value]
variations :: ![Value]
    }
    deriving ((forall x. FileFlag -> Rep FileFlag x)
-> (forall x. Rep FileFlag x -> FileFlag) -> Generic FileFlag
forall x. Rep FileFlag x -> FileFlag
forall x. FileFlag -> Rep FileFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileFlag x -> FileFlag
$cfrom :: forall x. FileFlag -> Rep FileFlag x
Generic, Value -> Parser [FileFlag]
Value -> Parser FileFlag
(Value -> Parser FileFlag)
-> (Value -> Parser [FileFlag]) -> FromJSON FileFlag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileFlag]
$cparseJSONList :: Value -> Parser [FileFlag]
parseJSON :: Value -> Parser FileFlag
$cparseJSON :: Value -> Parser FileFlag
FromJSON, Int -> FileFlag -> ShowS
[FileFlag] -> ShowS
FileFlag -> String
(Int -> FileFlag -> ShowS)
-> (FileFlag -> String) -> ([FileFlag] -> ShowS) -> Show FileFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileFlag] -> ShowS
$cshowList :: [FileFlag] -> ShowS
show :: FileFlag -> String
$cshow :: FileFlag -> String
showsPrec :: Int -> FileFlag -> ShowS
$cshowsPrec :: Int -> FileFlag -> ShowS
Show, FileFlag -> FileFlag -> Bool
(FileFlag -> FileFlag -> Bool)
-> (FileFlag -> FileFlag -> Bool) -> Eq FileFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileFlag -> FileFlag -> Bool
$c/= :: FileFlag -> FileFlag -> Bool
== :: FileFlag -> FileFlag -> Bool
$c== :: FileFlag -> FileFlag -> Bool
Eq)

expandSimpleFlag :: Value -> FileFlag
expandSimpleFlag :: Value -> FileFlag
expandSimpleFlag value :: Value
value =
    $WFileFlag :: Maybe Natural
-> Maybe Bool
-> Maybe [Target]
-> Maybe [Target]
-> Maybe [Rule]
-> Maybe VariationOrRollout
-> Maybe Integer
-> [Value]
-> FileFlag
FileFlag
        { $sel:version:FileFlag :: Maybe Natural
version = Maybe Natural
forall a. Maybe a
Nothing
        , $sel:on:FileFlag :: Maybe Bool
on = Maybe Bool
forall a. Maybe a
Nothing
        , $sel:targets:FileFlag :: Maybe [Target]
targets = Maybe [Target]
forall a. Maybe a
Nothing
        , $sel:contextTargets:FileFlag :: Maybe [Target]
contextTargets = Maybe [Target]
forall a. Maybe a
Nothing
        , $sel:rules:FileFlag :: Maybe [Rule]
rules = Maybe [Rule]
forall a. Maybe a
Nothing
        , $sel:fallthrough:FileFlag :: Maybe VariationOrRollout
fallthrough = VariationOrRollout -> Maybe VariationOrRollout
forall a. a -> Maybe a
Just (Maybe Integer -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout (Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0) Maybe Rollout
forall a. Maybe a
Nothing)
        , $sel:offVariation:FileFlag :: Maybe Integer
offVariation = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
        , $sel:variations:FileFlag :: [Value]
variations = [Value
value]
        }

fromFileFlag :: Text -> FileFlag -> F.Flag
fromFileFlag :: Text -> FileFlag -> Flag
fromFileFlag key :: Text
key fileFlag :: FileFlag
fileFlag =
    $WFlag :: Text
-> Natural
-> Bool
-> Bool
-> Bool
-> Bool
-> [Prerequisite]
-> Text
-> [Target]
-> [Target]
-> [Rule]
-> VariationOrRollout
-> Maybe Integer
-> [Value]
-> Maybe Natural
-> ClientSideAvailability
-> Flag
F.Flag
        { $sel:key:Flag :: Text
F.key = Text
key
        , $sel:version:Flag :: Natural
F.version = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Natural -> Natural) -> Maybe Natural -> Natural
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FileFlag
fileFlag
        , $sel:on:Flag :: Bool
F.on = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe Bool
on FileFlag
fileFlag
        , $sel:trackEvents:Flag :: Bool
F.trackEvents = Bool
False
        , $sel:trackEventsFallthrough:Flag :: Bool
F.trackEventsFallthrough = Bool
False
        , $sel:deleted:Flag :: Bool
F.deleted = Bool
False
        , $sel:prerequisites:Flag :: [Prerequisite]
F.prerequisites = []
        , $sel:salt:Flag :: Text
F.salt = ""
        , $sel:targets:Flag :: [Target]
F.targets = [Target] -> Maybe [Target] -> [Target]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Target] -> [Target]) -> Maybe [Target] -> [Target]
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe [Target]
targets FileFlag
fileFlag
        , $sel:contextTargets:Flag :: [Target]
F.contextTargets = [Target] -> Maybe [Target] -> [Target]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Target] -> [Target]) -> Maybe [Target] -> [Target]
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe [Target]
contextTargets FileFlag
fileFlag
        , $sel:rules:Flag :: [Rule]
F.rules = [Rule] -> Maybe [Rule] -> [Rule]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Rule] -> [Rule]) -> Maybe [Rule] -> [Rule]
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" FileFlag
fileFlag
        , $sel:fallthrough:Flag :: VariationOrRollout
F.fallthrough = VariationOrRollout
-> Maybe VariationOrRollout -> VariationOrRollout
forall a. a -> Maybe a -> a
fromMaybe VariationOrRollout
noFallthrough (Maybe VariationOrRollout -> VariationOrRollout)
-> Maybe VariationOrRollout -> VariationOrRollout
forall a b. (a -> b) -> a -> b
$ FileFlag -> Maybe VariationOrRollout
fallthrough FileFlag
fileFlag
        , $sel:offVariation:Flag :: Maybe Integer
F.offVariation = FileFlag -> Maybe Integer
offVariation FileFlag
fileFlag
        , $sel:variations:Flag :: [Value]
F.variations = FileFlag -> [Value]
variations FileFlag
fileFlag
        , $sel:debugEventsUntilDate:Flag :: Maybe Natural
F.debugEventsUntilDate = Maybe Natural
forall a. Maybe a
Nothing
        , $sel:clientSideAvailability:Flag :: ClientSideAvailability
F.clientSideAvailability = Bool -> Bool -> Bool -> ClientSideAvailability
F.ClientSideAvailability Bool
False Bool
False Bool
False
        }

noFallthrough :: F.VariationOrRollout
noFallthrough :: VariationOrRollout
noFallthrough =
    Maybe Integer -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout Maybe Integer
forall a. Maybe a
Nothing Maybe Rollout
forall a. Maybe a
Nothing

data FileSegment = FileSegment
    { FileSegment -> Maybe (HashSet Text)
included :: Maybe (HashSet Text)
    , FileSegment -> Maybe [SegmentTarget]
includedContexts :: Maybe [F.SegmentTarget]
    , FileSegment -> Maybe (HashSet Text)
excluded :: Maybe (HashSet Text)
    , FileSegment -> Maybe [SegmentTarget]
excludedContexts :: Maybe [F.SegmentTarget]
    , FileSegment -> Maybe [SegmentRule]
rules :: Maybe [F.SegmentRule]
    , FileSegment -> Maybe Natural
version :: Maybe Natural
    }
    deriving ((forall x. FileSegment -> Rep FileSegment x)
-> (forall x. Rep FileSegment x -> FileSegment)
-> Generic FileSegment
forall x. Rep FileSegment x -> FileSegment
forall x. FileSegment -> Rep FileSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileSegment x -> FileSegment
$cfrom :: forall x. FileSegment -> Rep FileSegment x
Generic, Value -> Parser [FileSegment]
Value -> Parser FileSegment
(Value -> Parser FileSegment)
-> (Value -> Parser [FileSegment]) -> FromJSON FileSegment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileSegment]
$cparseJSONList :: Value -> Parser [FileSegment]
parseJSON :: Value -> Parser FileSegment
$cparseJSON :: Value -> Parser FileSegment
FromJSON, Int -> FileSegment -> ShowS
[FileSegment] -> ShowS
FileSegment -> String
(Int -> FileSegment -> ShowS)
-> (FileSegment -> String)
-> ([FileSegment] -> ShowS)
-> Show FileSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSegment] -> ShowS
$cshowList :: [FileSegment] -> ShowS
show :: FileSegment -> String
$cshow :: FileSegment -> String
showsPrec :: Int -> FileSegment -> ShowS
$cshowsPrec :: Int -> FileSegment -> ShowS
Show, FileSegment -> FileSegment -> Bool
(FileSegment -> FileSegment -> Bool)
-> (FileSegment -> FileSegment -> Bool) -> Eq FileSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSegment -> FileSegment -> Bool
$c/= :: FileSegment -> FileSegment -> Bool
== :: FileSegment -> FileSegment -> Bool
$c== :: FileSegment -> FileSegment -> Bool
Eq)

fromFileSegment :: Text -> FileSegment -> F.Segment
fromFileSegment :: Text -> FileSegment -> Segment
fromFileSegment key :: Text
key fileSegment :: FileSegment
fileSegment =
    $WSegment :: Text
-> HashSet Text
-> [SegmentTarget]
-> HashSet Text
-> [SegmentTarget]
-> Text
-> [SegmentRule]
-> Natural
-> Bool
-> Segment
F.Segment
        { $sel:key:Segment :: Text
F.key = Text
key
        , $sel:version:Segment :: Natural
F.version = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Natural -> Natural) -> Maybe Natural -> Natural
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FileSegment
fileSegment
        , $sel:included:Segment :: HashSet Text
F.included = HashSet Text -> Maybe (HashSet Text) -> HashSet Text
forall a. a -> Maybe a -> a
fromMaybe HashSet Text
forall a. Monoid a => a
mempty (Maybe (HashSet Text) -> HashSet Text)
-> Maybe (HashSet Text) -> HashSet Text
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe (HashSet Text)
included FileSegment
fileSegment
        , $sel:includedContexts:Segment :: [SegmentTarget]
F.includedContexts = [SegmentTarget] -> Maybe [SegmentTarget] -> [SegmentTarget]
forall a. a -> Maybe a -> a
fromMaybe [SegmentTarget]
forall a. Monoid a => a
mempty (Maybe [SegmentTarget] -> [SegmentTarget])
-> Maybe [SegmentTarget] -> [SegmentTarget]
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe [SegmentTarget]
includedContexts FileSegment
fileSegment
        , $sel:excluded:Segment :: HashSet Text
F.excluded = HashSet Text -> Maybe (HashSet Text) -> HashSet Text
forall a. a -> Maybe a -> a
fromMaybe HashSet Text
forall a. Monoid a => a
mempty (Maybe (HashSet Text) -> HashSet Text)
-> Maybe (HashSet Text) -> HashSet Text
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe (HashSet Text)
excluded FileSegment
fileSegment
        , $sel:excludedContexts:Segment :: [SegmentTarget]
F.excludedContexts = [SegmentTarget] -> Maybe [SegmentTarget] -> [SegmentTarget]
forall a. a -> Maybe a -> a
fromMaybe [SegmentTarget]
forall a. Monoid a => a
mempty (Maybe [SegmentTarget] -> [SegmentTarget])
-> Maybe [SegmentTarget] -> [SegmentTarget]
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe [SegmentTarget]
excludedContexts FileSegment
fileSegment
        , $sel:salt:Segment :: Text
F.salt = ""
        , $sel:rules:Segment :: [SegmentRule]
F.rules = [SegmentRule] -> Maybe [SegmentRule] -> [SegmentRule]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SegmentRule] -> [SegmentRule])
-> Maybe [SegmentRule] -> [SegmentRule]
forall a b. (a -> b) -> a -> b
$ FileSegment -> Maybe [SegmentRule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" FileSegment
fileSegment
        , $sel:deleted:Segment :: Bool
F.deleted = Bool
False
        }

data FileBody = FileBody
    { FileBody -> Maybe (KeyMap FileFlag)
flags :: Maybe (KeyMap FileFlag)
    , FileBody -> Maybe (KeyMap Value)
flagValues :: Maybe (KeyMap Value)
    , FileBody -> Maybe (KeyMap FileSegment)
segments :: Maybe (KeyMap FileSegment)
    }
    deriving ((forall x. FileBody -> Rep FileBody x)
-> (forall x. Rep FileBody x -> FileBody) -> Generic FileBody
forall x. Rep FileBody x -> FileBody
forall x. FileBody -> Rep FileBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileBody x -> FileBody
$cfrom :: forall x. FileBody -> Rep FileBody x
Generic, Int -> FileBody -> ShowS
[FileBody] -> ShowS
FileBody -> String
(Int -> FileBody -> ShowS)
-> (FileBody -> String) -> ([FileBody] -> ShowS) -> Show FileBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileBody] -> ShowS
$cshowList :: [FileBody] -> ShowS
show :: FileBody -> String
$cshow :: FileBody -> String
showsPrec :: Int -> FileBody -> ShowS
$cshowsPrec :: Int -> FileBody -> ShowS
Show, Value -> Parser [FileBody]
Value -> Parser FileBody
(Value -> Parser FileBody)
-> (Value -> Parser [FileBody]) -> FromJSON FileBody
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileBody]
$cparseJSONList :: Value -> Parser [FileBody]
parseJSON :: Value -> Parser FileBody
$cparseJSON :: Value -> Parser FileBody
FromJSON)

instance Semigroup FileBody where
    f1 :: FileBody
f1 <> :: FileBody -> FileBody -> FileBody
<> f2 :: FileBody
f2 =
        FileBody :: Maybe (KeyMap FileFlag)
-> Maybe (KeyMap Value) -> Maybe (KeyMap FileSegment) -> FileBody
FileBody
            { $sel:flags:FileBody :: Maybe (KeyMap FileFlag)
flags = FileBody -> Maybe (KeyMap FileFlag)
flags FileBody
f1 Maybe (KeyMap FileFlag)
-> Maybe (KeyMap FileFlag) -> Maybe (KeyMap FileFlag)
forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap FileFlag)
flags FileBody
f2
            , $sel:flagValues:FileBody :: Maybe (KeyMap Value)
flagValues = FileBody -> Maybe (KeyMap Value)
flagValues FileBody
f1 Maybe (KeyMap Value)
-> Maybe (KeyMap Value) -> Maybe (KeyMap Value)
forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap Value)
flagValues FileBody
f2
            , $sel:segments:FileBody :: Maybe (KeyMap FileSegment)
segments = FileBody -> Maybe (KeyMap FileSegment)
segments FileBody
f1 Maybe (KeyMap FileSegment)
-> Maybe (KeyMap FileSegment) -> Maybe (KeyMap FileSegment)
forall a. Semigroup a => a -> a -> a
<> FileBody -> Maybe (KeyMap FileSegment)
segments FileBody
f2
            }
instance Monoid FileBody where
    mempty :: FileBody
mempty =
        FileBody :: Maybe (KeyMap FileFlag)
-> Maybe (KeyMap Value) -> Maybe (KeyMap FileSegment) -> FileBody
FileBody
            { $sel:flags:FileBody :: Maybe (KeyMap FileFlag)
flags = Maybe (KeyMap FileFlag)
forall a. Monoid a => a
mempty
            , $sel:flagValues:FileBody :: Maybe (KeyMap Value)
flagValues = Maybe (KeyMap Value)
forall a. Monoid a => a
mempty
            , $sel:segments:FileBody :: Maybe (KeyMap FileSegment)
segments = Maybe (KeyMap FileSegment)
forall a. Monoid a => a
mempty
            }
    mappend :: FileBody -> FileBody -> FileBody
mappend = FileBody -> FileBody -> FileBody
forall a. Semigroup a => a -> a -> a
(<>)

-- |
-- Creates a @DataSourceFactory@ which uses the configured file data sources.
--
-- This allows you to use local files as a source of feature flag state,
-- instead of using an actual LaunchDarkly connection.
--
-- To use the file dataSource you can add it to the
-- 'LaunchDarkly.Server.Config' using
-- 'LaunchDarkly.Server.Config.configSetDataSourceFactory'
--
-- @
-- let config = configSetDataSourceFactory (FileData.dataSourceFactory ["./testData/flags.json"]) $
--              makeConfig "sdk-key"
-- client <- makeClient config
-- @
--
-- This will cause the client /not/ to connect to LaunchDarkly to get feature
-- flags. The client may still make network connections to send analytics
-- events, unless you have disabled this with
-- 'LaunchDarkly.Server.Config.configSetSendEvents' to @False@. IMPORTANT: Do
-- /not/ set 'LaunchDarkly.Server.Config.configSetOffline' to @True@; doing so
-- would not just put the SDK \"offline\" with regard to LaunchDarkly, but will
-- completely turn off all flag data sources to the SDK /including the file
-- data source/.
--
-- Flag data files can be either JSON or YAML. They contain an object with
-- three possible properties:
--
--      [@flags@]: Feature flag definitions.
--      [@flagValues@]: Simplified feature flags that contain only a value.
--      [@segments@]: Context segment definitions.
--
-- The format of the data in @flags@ and @segments@ is defined by the
-- LaunchDarkly application and is subject to change. Rather than trying to
-- construct these objects yourself, it is simpler to request existing flags
-- directly from the LaunchDarkly server in JSON format, and use this output as
-- the starting point for your file. In Linux you would do this:
--
-- @
-- curl -H "Authorization: {your sdk key}" https://sdk.launchdarkly.com/sdk/latest-all
-- @
--
-- The output will look something like this (but with many more properties):
--
-- @
-- {
--     "flags": {
--         "flag-key-1": {
--             "key": "flag-key-1",
--             "on": true,
--             "variations": [ "a", "b" ]
--         },
--         "flag-key-2": {
--             "key": "flag-key-2",
--             "on": true,
--             "variations": [ "c", "d" ]
--         }
--     },
--     "segments": {
--         "segment-key-1": {
--             "key": "segment-key-1",
--             "includes": [ "user-key-1" ]
--         }
--     }
-- }
-- @
--
-- Data in this format allows the SDK to exactly duplicate all the kinds of
-- flag behavior supported by LaunchDarkly. However, in many cases you will not
-- need this complexity, but will just want to set specific flag keys to
-- specific values. For that, you can use a much simpler format:
--
-- @
-- {
--     "flagValues": {
--         "my-string-flag-key": "value-1",
--         "my-boolean-flag-key": true,
--         "my-integer-flag-key": 3
--     }
-- }
-- @
--
-- Or, in YAML:
--
-- @
-- flagValues:
--   my-string-flag-key: "value-1"
--   my-boolean-flag-key: true
-- @
--
-- It is also possible to specify both @flags@ and @flagValues@, if you want
-- some flags to have simple values and others to have complex behavior.
-- However, it is an error to use the same flag key or segment key more than
-- once, either in a single file or across multiple files.
--
-- If the data source encounters any error in any file(malformed content, a
-- missing file) it will not load flags from that file. If the data source
-- encounters a duplicate key it will ignore that duplicate entry.
--
-- @since 2.2.1
dataSourceFactory :: [FilePath] -> DataSourceFactory
dataSourceFactory :: [String] -> DataSourceFactory
dataSourceFactory sources :: [String]
sources _clientContext :: ClientContext
_clientContext dataSourceUpdates :: DataSourceUpdates
dataSourceUpdates = do
    IORef Bool
inited <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    let dataSourceIsInitialized :: IO Bool
dataSourceIsInitialized =
            IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
inited
        dataSourceStart :: IO ()
dataSourceStart = do
            FileBody mFlags :: Maybe (KeyMap FileFlag)
mFlags mFlagValues :: Maybe (KeyMap Value)
mFlagValues mSegments :: Maybe (KeyMap FileSegment)
mSegments <- [FileBody] -> FileBody
forall a. Monoid a => [a] -> a
mconcat ([FileBody] -> FileBody) -> IO [FileBody] -> IO FileBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO FileBody) -> [String] -> IO [FileBody]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO FileBody
loadFile [String]
sources
            let mSimpleFlags :: Maybe (KeyMap FileFlag)
mSimpleFlags = (KeyMap Value -> KeyMap FileFlag)
-> Maybe (KeyMap Value) -> Maybe (KeyMap FileFlag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> FileFlag) -> KeyMap Value -> KeyMap FileFlag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> FileFlag
expandSimpleFlag) Maybe (KeyMap Value)
mFlagValues
                flags' :: HashMap Text Flag
flags' = HashMap Text Flag
-> (KeyMap FileFlag -> HashMap Text Flag)
-> Maybe (KeyMap FileFlag)
-> HashMap Text Flag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Text Flag
forall a. Monoid a => a
mempty ((Text -> FileFlag -> Flag) -> KeyMap FileFlag -> HashMap Text Flag
forall v1 v2.
(Text -> v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapWithKey Text -> FileFlag -> Flag
fromFileFlag) (Maybe (KeyMap FileFlag)
mFlags Maybe (KeyMap FileFlag)
-> Maybe (KeyMap FileFlag) -> Maybe (KeyMap FileFlag)
forall a. Semigroup a => a -> a -> a
<> Maybe (KeyMap FileFlag)
mSimpleFlags)
                segments' :: HashMap Text Segment
segments' = HashMap Text Segment
-> (KeyMap FileSegment -> HashMap Text Segment)
-> Maybe (KeyMap FileSegment)
-> HashMap Text Segment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Text Segment
forall a. Monoid a => a
mempty ((Text -> FileSegment -> Segment)
-> KeyMap FileSegment -> HashMap Text Segment
forall v1 v2.
(Text -> v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapWithKey Text -> FileSegment -> Segment
fromFileSegment) Maybe (KeyMap FileSegment)
mSegments
            Either Text ()
_ <- DataSourceUpdates
-> HashMap Text Flag -> HashMap Text Segment -> IO (Either Text ())
dataSourceUpdatesInit DataSourceUpdates
dataSourceUpdates HashMap Text Flag
flags' HashMap Text Segment
segments'
            DataSourceUpdates -> Status -> IO ()
dataSourceUpdatesSetStatus DataSourceUpdates
dataSourceUpdates Status
Initialized
            IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
inited Bool
True
        dataSourceStop :: f ()
dataSourceStop = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    DataSource -> IO DataSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSource -> IO DataSource) -> DataSource -> IO DataSource
forall a b. (a -> b) -> a -> b
$ DataSource :: IO Bool -> IO () -> IO () -> DataSource
DataSource {..}

loadFile :: FilePath -> IO FileBody
loadFile :: String -> IO FileBody
loadFile filePath :: String
filePath = do
    ByteString
file <- String -> IO ByteString
BSL.readFile String
filePath
    let mDecodedFile :: Maybe FileBody
mDecodedFile = ByteString -> Maybe FileBody
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
file Maybe FileBody -> Maybe FileBody -> Maybe FileBody
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Maybe FileBody
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Yaml.decodeThrow (ByteString -> ByteString
BSL.toStrict ByteString
file)
    case Maybe FileBody
mDecodedFile of
        Just !FileBody
fileBody ->
            FileBody -> IO FileBody
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileBody
fileBody
        Nothing ->
            FileBody -> IO FileBody
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileBody
forall a. Monoid a => a
mempty