Algebra.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}

-- |The internal \"algebraic\" interface for working with property-list-like
-- things.  The classes defined here are the basis for a very general system
-- supporting transformations between many property-list representations,
-- including both internal and external formats.  The transformations are
-- based on algebra and are very well-behaved mathematically.  It is possible
-- to \"fuse\" operations so that, for example, reading from XML and writing
-- to a text plist can be done without creating any intermediate 
-- representations other than those used by the XML parser and the text 
-- renderer.  Or, expressions using the \"smart constructors\" can be
-- evaluated to directly synthesize XML-formatted plists, or the view-pattern
-- destructors can be used to directly analyze them.
-- 
-- The interface defined in this module is very heavily influenced by 
-- category-theoretical constructions.  In particular, F-algebras and 
-- F-coalgebras, initiality, and terminality.  For those not familiar with
-- these concepts, this will probably be quite incomprehensible.  Sorry
-- about that.  The basic idea, though, is the use of the 'PropertyListS' 
-- type as a sort of a central junction point through which all conversions
-- between property-list-like types and property-list-item types are routed.
-- The classes defined here are chosen to minimize the inderdependence of
-- these types and hence maximize the flexibility of the system as a whole.
--
-- More simply stated, these weird math thingies make the design
-- as flexible as possible (in a well-defined and useful sense).
module Data.PropertyList.Algebra where

import Control.Applicative
import Data.Functor.Identity
import Data.ByteString as B hiding (map)
import Data.Foldable (Foldable(foldMap))
import qualified Data.Map as M
import Data.Monoid
import Data.Time
import Data.Traversable (Traversable(..))

-- * The signature type ('PropertyListS')

-- |The signature of the base property list algebra.  This algebra is 
-- \"lifted\" in various ways to support several different but similar
-- representations of property lists as well as projections and
-- injections.  All the different representations are 'connected' through
-- this signature.
-- 
-- For example, 'PropertyList' is a fixed-point of this signature - that
-- is, a recursive version where @a@ is instantiated as @'PropertyListS' a@.
-- That gives the \"expected\" structure of a basic property list.  It is both
-- initial and terminal for this signature in its 'un-lifted' form - which
-- is to say, any other type with an algebra for this signature (such as an 
-- XML representation) can be made from a 'PropertyList', and any type with
-- a coalgebra for this signature (such as a 'String', an 'Integer', etc.)
-- can be converted directly to a 'PropertyList'.  This also means that any
-- transformation or series of transformations involving the 'PropertyList'
-- type can be fused to \"skip\" generating intermediate property lists, 
-- although there are currently no rewrite rules set up to do so.
--
-- Similarly, 'PartialPropertyList' is a fixed point of an arbitrarily-
-- augmented version of this signature (also known as the free monad 
-- generated by the signature).  Depending on its type parameter, 
-- 'PartialPropertyList' can be terminal among many simple extensions to 
-- the signature.  Thus many types with a coalgebra for an extension of 
-- this signature (such as XML given an appropriate tree destructor, or 
-- the 'PropertyList' type itself)  can be trivially converted to a 
-- 'PartialPropertyList'.
data PropertyListS a
    = PLArray [a]
    | PLData ByteString
    | PLDate UTCTime
    | PLDict  (M.Map String a)
    | PLReal Double
    | PLInt Integer
    | PLString String
    | PLBool Bool
    deriving (Eq, Ord, Show, Read)

-- |Construct a basic non-recursive algebra of property list items.
-- This is equivalent to pattern matching on 'PropertyListS'.
foldPropertyListS :: ([a] -> t)
                  -> (ByteString -> t)
                  -> (UTCTime -> t)
                  -> (M.Map String a -> t)
                  -> (Double -> t)
                  -> (Integer -> t)
                  -> (String -> t)
                  -> (Bool -> t) 
                  -> PropertyListS a -> t
foldPropertyListS plArray plData plDate plDict plReal plInt plString plBool pl =
    case pl of
        PLArray   x -> plArray   x
        PLData    x -> plData    x
        PLDate    x -> plDate    x
        PLDict    x -> plDict    x
        PLReal    x -> plReal    x
        PLInt     x -> plInt     x
        PLString  x -> plString  x
        PLBool    x -> plBool    x

instance Functor PropertyListS where
    fmap f = foldPropertyListS (PLArray . fmap f) PLData PLDate (PLDict . fmap f) PLReal PLInt PLString PLBool

instance Foldable PropertyListS where
    foldMap f = foldPropertyListS (foldMap f) mempty mempty (foldMap f) mempty mempty mempty mempty

instance Traversable PropertyListS where
    sequenceA = foldPropertyListS (fmap PLArray . sequenceA) (pure . PLData) (pure . PLDate) (fmap PLDict . sequenceA) (pure . PLReal) (pure . PLInt) (pure . PLString) (pure . PLBool)

-- * The algebra and coalgebra classes

-- |A class for types which can be constructed algebraically from the
-- 'PropertyListS' signature (lifted by @f@) - in other words, types which
-- you can put property lists into.
-- 
-- The @f@-lifting is provided to support extending the algebra.  The algebra
-- is defined in a class rather than passing around functions because most of
-- the time for any given type there is only one algebra you care about.
--
-- Typically a renderer for an output format will be implemented as a type
-- with an @instance 'PListAlgebra' 'Identity'@.  For example, the XML 
-- output system is implemented in the @instance 'PListAlgebra' 'Identity' 
-- 'Data.PropertyList.Xml.Types.Plist'@.
class Functor f => PListAlgebra f a where
    -- |Build a value of type @a@ from a piece of a property list (using
    -- the 'PropertyListS' signature augmented by the \"lifting\" @f@).
    plistAlgebra :: f (PropertyListS a) -> a

-- |An identification of the fact that the type @a@ has an initial plist algebra
-- (under some lifting @f@).  Functional dependencies are in use - for any 
-- type, only one of its initial algebras (if multiple apply, which they may
-- because the same type may be initial for multiple distinct liftings)
-- can be chosen, and for any lifting only one type's algebra may be chosen.
-- This is to make types decidable in the not-so-uncommon case where the
-- lifting is encapsulated (eg, any time 'foldPList' is partially applied
-- - for example, see the signature of 'fromPlist').
-- 
-- For cases where the lifting either needs to be chosen or needs to be
-- transformed to another lifting, 'fromPlistWith' is provided.  It is based
-- on the same definition as the default implementation of 'foldPList' but
-- also inserts a chosen transformation of the lifting.
-- 
-- Question for self: Is the PListCoalgebra context reasonable here?  
-- Some rough calculations suggest that in the presence of fixed point 
-- type operators, it is possible to construct a PListCoalgebra for any 
-- InitialPList, which essentially is defined as pattern matching.  So, 
-- I'm not totally sure but I think this is reasonable - at least, for
-- finitary signatures, which we're using as long as @f@ doesn't go crazy.
class (PListAlgebra f a, PListCoalgebra f a) => InitialPList f a | f -> a, a -> f where
    -- |Using some other plist algebra, compute the unique transformation from
    -- the type @a@ to that algebra.
    -- 
    -- The default implementation is:
    --
    -- > foldPList f = go
    -- >    where
    -- >        go = f . fmap (fmap go) . plistCoalgebra
    --
    foldPList :: (f (PropertyListS t) -> t) -> a -> t
    foldPList f = go
        where
            go = f . fmap (fmap go) . plistCoalgebra

-- |Convert from an initial plist to any other plist with the same lifted algebra.
fromPlist :: (InitialPList f pl, PListAlgebra f t) => pl -> t
fromPlist = foldPList plistAlgebra

-- If the transformation is natural, this is equivalent to 'toPlistWith'.  I think.
fromPlistWith :: (PListCoalgebra f pl, PListAlgebra g t) => (f (PropertyListS t) -> g (PropertyListS t)) -> pl -> t
fromPlistWith lift = fold
    where
        fold = plistAlgebra . lift . fmap (fmap fold) . plistCoalgebra

-- |A class for types which can be dissected (pattern-matched) into the
-- 'PropertyListS' signature (lifted by @f@) - in other words, types which
-- you can take property lists out of.
--
-- Typically a property list parser will be implemented as a type with a
-- 'PListCoalgebra' instance, where @f@ is either 'Identity' in the case where
-- the parser guarantees to return a fully well-formed property list 
-- (assuming it returns anything at all) or 'Either' @something@ when the 
-- parser only guarantees that the structure is sound (but that some elements
-- might be defective, in which case a value of type @something@ would be 
-- substituted).  The XML parser, for example, is based on the latter 
-- approach, where @something@ is 'UnparsedPlistItem'.
class Functor f => PListCoalgebra f a where
    -- |Analyze a value of type @a@ by matching it to a constructor in the
    -- (lifted by @f@) 'PropertyListS' signature.
    plistCoalgebra :: a -> f (PropertyListS a)

-- |Chosen terminal coalgebra for the given lifting, and chosen lifting
-- for the given type.  See also 'InitialPList'.
class (PListCoalgebra f a, PListAlgebra f a) => TerminalPList f a | f -> a, a -> f where
    -- |Given some coalgebra for the chosen lifted plist signature, compute
    -- the unique extraction/unfolding of that coalgebra into the type @a@.
    -- 
    -- The default implementation is:
    -- 
    -- > unfoldPList f = go
    -- >     where
    -- >         go = plistAlgebra . fmap (fmap go) . f
    -- 
    unfoldPList :: (t -> f (PropertyListS t)) -> t -> a
    unfoldPList f = go
        where
            go = plistAlgebra . fmap (fmap go) . f

-- |Convert from any plist-like thing to a plist which is terminal for a some lifted algebra.
toPlist :: (PListCoalgebra f t, TerminalPList f pl) => t -> pl
toPlist = unfoldPList plistCoalgebra

-- If the transformation is natural, this is equivalent to 'fromPlistWith'.  I think.
toPlistWith :: (PListCoalgebra f t, PListAlgebra g pl) => (f (PropertyListS t) -> g (PropertyListS t)) -> t -> pl
toPlistWith lift = unfold
    where
        unfold = plistAlgebra . fmap (fmap unfold) . lift . plistCoalgebra
        

-- * \"Smart\" constructors for any 'PListAlgebra'.

plArray :: (PListAlgebra Identity a) => [a] -> a
plArray     x   = plistAlgebra (Identity $ PLArray  x)

plData :: (PListAlgebra Identity a) => ByteString -> a
plData      x   = plistAlgebra (Identity $ PLData   x)

plDate :: (PListAlgebra Identity a) => UTCTime -> a
plDate      x   = plistAlgebra (Identity $ PLDate   x)

plDict :: (PListAlgebra Identity a) => M.Map String a -> a
plDict      x   = plistAlgebra (Identity $ PLDict   x)

plReal :: (PListAlgebra Identity a) => Double -> a
plReal      x   = plistAlgebra (Identity $ PLReal   x)

plInt :: (PListAlgebra Identity a) => Integer -> a
plInt       x   = plistAlgebra (Identity $ PLInt    x)

plString :: (PListAlgebra Identity a) => String -> a
plString    x   = plistAlgebra (Identity $ PLString x)

plBool :: (PListAlgebra Identity a) => Bool -> a
plBool      x   = plistAlgebra (Identity $ PLBool   x)

-- * \"View pattern\" destructors for any 'PListCoalgebra'.

fromPlArray :: PListCoalgebra Maybe a => a -> Maybe [a]
fromPlArray pl = do PLArray a <- plistCoalgebra pl; return a

fromPlData :: PListCoalgebra Maybe a => a -> Maybe ByteString
fromPlData pl = do PLData a <- plistCoalgebra pl; return a

fromPlDate :: PListCoalgebra Maybe a => a -> Maybe UTCTime
fromPlDate pl = do PLDate a <- plistCoalgebra pl; return a

fromPlDict :: PListCoalgebra Maybe a => a -> Maybe (M.Map String a)
fromPlDict pl = do PLDict a <- plistCoalgebra pl; return a

fromPlReal :: PListCoalgebra Maybe a => a -> Maybe Double
fromPlReal pl = do PLReal a <- plistCoalgebra pl; return a

fromPlInt :: PListCoalgebra Maybe a => a -> Maybe Integer
fromPlInt pl = do PLInt a <- plistCoalgebra pl; return a

fromPlString :: PListCoalgebra Maybe a => a -> Maybe String
fromPlString pl = do PLString a <- plistCoalgebra pl; return a

fromPlBool :: PListCoalgebra Maybe a => a -> Maybe Bool
fromPlBool pl = do PLBool a <- plistCoalgebra pl; return a