{- |
  Legion is a mathematically sound framework for writing horizontally
  scalable business logic, or applications. Historically,
  horizontal scalability has been achieved via the property of
  statelessness. Programmers would design their applications to be free
  of any kind of persistent state, avoiding the problem of distributed
  state management. This almost never turns out to really be possible,
  so programmers achieve "statelessness" by delegating application state
  management to some kind of external, shared database (which ends up
  having its own scalability problems).

  In addition to scalability problems, which modern databases (especially
  NoSQL databases) have done a good job of solving, there is another,
  more fundamental problem facing these architectures: The application
  is not really stateless.

  Legion is a Haskell framework that abstracts state partitioning, data
  replication, request routing, and cluster rebalancing, making it easy
  to implement large and robust distributed stateful applications.
-}

module Network.Legion (
  -- * API Reference

  -- ** Starting the Legion Runtime
  forkLegionary,
  StartupMode(..),
  Runtime,

  -- ** Making Runtime Requests
  makeRequest,
  search,

  -- ** Application Definition
  LegionConstraints,
  Persistence(..),
  Event(..),

  -- ** Runtime Configuration
  -- $framework-config
  RuntimeSettings(..),

  -- ** Indexing
  Indexable(..),
  Tag(..),
  SearchTag(..),
  IndexRecord(..),

  -- ** Other Types
  Peer,
  PartitionKey(..),
  PartitionPowerState,
  ClusterPowerState,

  -- * Implementing a Legion Application
  -- $service-implementaiton

  -- ** Typclasses to Implement
  -- $constraints

  -- *** Event
  -- $event

  -- *** Indexable
  -- $indexable

  -- ** Exposing Your Application
  -- $expose

  -- ** Partitions, Explained
  -- $partitions

  -- ** The Persistence Layer
  -- $persistence

) where

import Prelude hiding (lookup, readFile, writeFile, null)

import Network.Legion.Application (LegionConstraints,
  Persistence(Persistence, getState, saveState, list, saveCluster))
import Network.Legion.ClusterState (ClusterPowerState)
import Network.Legion.Distribution (Peer)
import Network.Legion.Index (Tag(Tag, unTag), IndexRecord(IndexRecord,
  irTag, irKey), SearchTag(SearchTag, stTag, stKey),
  Indexable(indexEntries))
import Network.Legion.PartitionKey (PartitionKey(K, unKey))
import Network.Legion.PartitionState (PartitionPowerState)
import Network.Legion.PowerState (Event(apply))
import Network.Legion.Runtime (StartupMode(NewCluster, JoinCluster, Recover),
  forkLegionary, Runtime, makeRequest, search)
import Network.Legion.Settings (RuntimeSettings(RuntimeSettings,
  adminHost, adminPort, peerBindAddr, joinBindAddr))

--------------------------------------------------------------------------------

-- $framework-config
-- The legion framework has several operational parameters which can be
-- controlled using configuration. These include the address binding used
-- to expose the cluster management service endpoint and what file to use
-- for cluster state journaling. To get started quickly, consider using
-- @[legion-extra:Network.Legion.Config](https://hackage.haskell.org/package/legion-extra/docs/Network-Legion-Config.html)@

--------------------------------------------------------------------------------

-- $service-implementaiton
-- Implementing a Legion application boils down to
-- two things: providing a persistence layer (see the
-- [legion-extra](https://hackage.haskell.org/package/legion-extra)
-- package for some pre-packaged persistence layers), and implementing
-- all of the typeclasses in 'LegionConstraints', of which 'Event'
-- is the most important.
--
-- Take a look at
-- @[Network.Legion.Discovery.LegionApp](https://github.com/owensmurray/legion-discovery/blob/master/src/Network/Legion/Discovery/LegionApp.hs)@
-- for a good example of how to build a core Legion application.

--------------------------------------------------------------------------------

-- $constraints
-- Lets take a look at 'LegionConstraints':
--
-- > (
-- >   Event e o s,
-- >   Indexable s,
-- >   
-- >   Binary e, Binary o, Binary s, Default s, Eq e, Show e, Show o, Show s
-- > )
--
-- First, a note on the type variables uesd:
--
-- - @__e__@ is the type of request your application will handle. @__e__@ stands
--   for __"event"__.
-- - @__o__@ is the type of response produced by your application. @__o__@ stands
--   for __"output"__
-- - @__s__@ is the type of state maintained by your application. More
--   precisely, it is the type of the individual partitions that make up
--   your global application state. @__s__@ stands for __"state"__.
--
-- The two most important typeclasses here are 'Event' and
-- 'Indexable'. The rest are mainly used for implementation details, like
-- packaging up data to send over the network, and constructing log messages,
-- etc.
   
--------------------------------------------------------------------------------

-- $event
-- Your 'Event' instance will serve as the core of your application. If you
-- think of your application as a large state machine, with inputs, state
-- changes and outputs, then the 'Event' typeclass acts as the main state
-- transition function.
--
-- > class Event e o s | e -> s o where
-- >   apply :: e -> s -> (o, s)
--
-- The 'apply' function acts like a state transition function. It
-- handles application inputs (which are the events themselves), state
-- transitions, and outputs. In other words, your 'Event' instance __is__
-- your legion application.
--
-- You will notice that the 'apply' function is totally pure. The
-- idea is that Legion will handle all of the necessary IO. It will
-- push events around on the network. It will retrieve state from the
-- persistence layer and automatically invoke your 'apply' function
-- where appropriate. This purity is necessary because it is the nature
-- of distributed, replicated systems that the order of events may
-- sometimes need to be rearranged, and the events themselves will have
-- to be replicated, and therefore applied more than once (at least one
-- time for each replica).

--------------------------------------------------------------------------------

-- $indexable
-- The next important typeclass is 'Indexable'.
--
-- > class Indexable s where
-- >   indexEntries :: s -> Set Tag
--
-- For handling regular requests using 'makeRequest', you must know
-- the key of the partition you are looking for a priori. Sometimes,
-- though, you want to look up some unknown set of partitions based
-- on another attribute. The most basic example is when you want to do a
-- simple listing of all the partition keys in the system.
--
-- This is where the indexing system and the 'search' function come
-- in. The indexing system is exposed at a relatively low level of
-- abstraction because the use cases for which it is needed will vary
-- wildly from application to application. There is only a single global
-- index, but each partition may produce zero to many records in that
-- index. This is what the @Set Tag@ portion of the type signature above
-- is all about.
--
-- Conceptually, the "index" is a single, global, ordered list of
-- 'IndexRecord's. The 'search' function allows you to scroll forward
-- through this list at will.
--
-- Indexing is implemented by instantiating the 'Indexable' typeclass
-- for your state type.
--
-- The tags returned by 'indexEntries' are used to construct a set of zero
-- or more 'IndexRecord's. For each 'Tag' returned by 'indexEntries',
-- an 'IndexRecord' is generated such that:
--
-- > IndexRecord {irTag = <your tag>, irKey = <partition key>}


--------------------------------------------------------------------------------

-- $expose
-- The interface to your new application is a Haskell
-- api, which isn't very useful on its own. You are
-- usually going to want to provide a wrapper around your
-- core Legion app so that it is accessible to the outside world.  The
-- [Legion-Discovery](https://github.com/owensmurray/legion-discovery/blob/master/src/Network/Legion/Discovery/Server.hs)
-- application uses [Servant](https://hackage.haskell.org/package/servant)
-- to expose its core Legion application via a web interface.

--------------------------------------------------------------------------------

-- $partitions
-- Coming soon.

-- The unit of state that Legion knows about is called a \"partition\". Each
-- partition is identified by a 'PartitionKey', and it is replicated across
-- the cluster. Each partition acts as the unit of state for handling
-- stateful user requests which are routed to it based on the `PartitionKey`
-- associated with the request. What the stateful part of Legion is
-- /not/ able to do is figure out what partition key is associated with
-- the request in the first place.

--------------------------------------------------------------------------------

-- $persistence
-- Coming soon.

-- The persistence layer provides the framework with a way to store the
-- various partition states. This allows you to choose any number of
-- persistence strategies, including only in memory, on disk, or in some
-- external database.
--
-- See 'newMemoryPersistence' and 'diskPersistence' if you need to get
-- started quickly with an in-memory persistence layer.