module Data.PropertyList.Xml.Parse where
import Language.Haskell.TH.Fold
import Prelude as P
#ifdef HaXml_1_13
import Data.PropertyList.Xml.Dtd_1_13 as X
#else
import Data.PropertyList.Xml.Dtd as X
#endif
import Data.PropertyList.Algebra
import Data.PropertyList.Xml.Types
import Control.Functor.Pointed
import Control.Arrow ((+++))
import Control.Monad.Identity
import qualified Data.Map as M
import Data.ByteString as B hiding (map)
import Data.Time
import System.Locale
import Codec.Binary.Base64 as B64
import Text.XML.HaXml.OneOfN
data UnparsedPlistItem
= UnparsedData String
| UnparsedDate String
| UnparsedInt String
| UnparsedReal String
deriving (Eq, Ord, Show, Read)
dateFormat :: String
dateFormat = "%FT%TZ"
instance PListAlgebra f PlistItem => PListAlgebra f Plist where
plistAlgebra = plistItemToPlist . plistAlgebra . fmap (fmap plistToPlistItem)
instance Copointed f => PListAlgebra f PlistItem where
plistAlgebra = foldPropertyListS
(\x -> OneOf9 (Array x)
) (\x -> TwoOf9 (Data (encode (unpack x)))
) (\x -> ThreeOf9 (Date (formatTime defaultTimeLocale dateFormat x))
) (\x -> FourOf9 (Dict [Dict_ (Key k) v | (k,v) <- M.toList x])
) (\x -> FiveOf9 (AReal (show x))
) (\x -> SixOf9 (AInteger (show x))
) (\x -> SevenOf9 (AString x)
) (\x -> if x then EightOf9 X.True else NineOf9 X.False
) . extract
instance PListAlgebra (Either UnparsedPlistItem) PlistItem where
plistAlgebra (Left unparsed) = unparsedPlistItemToPlistItem unparsed
plistAlgebra (Right parsed) = plistAlgebra (Identity parsed)
instance PListAlgebra (Either PlistItem) PlistItem where
plistAlgebra (Left unparsed) = unparsed
plistAlgebra (Right parsed) = plistAlgebra (Identity parsed)
instance PListCoalgebra (Either UnparsedPlistItem) PlistItem where
plistCoalgebra item = case item of
OneOf9 (Array x ) -> accept PLArray x
TwoOf9 (Data x ) -> case decode x of
Just d -> accept PLData (pack d)
Nothing -> reject UnparsedData x
ThreeOf9 (Date x ) -> case parseTime defaultTimeLocale dateFormat x of
Just t -> accept PLDate t
Nothing -> reject UnparsedDate x
FourOf9 (Dict x ) -> accept PLDict (M.fromList [ (k, v) | Dict_ (Key k) v <- x])
FiveOf9 (AReal x ) -> tryRead PLReal UnparsedReal x
SixOf9 (AInteger x) -> tryRead PLInt UnparsedInt x
SevenOf9 (AString x) -> accept PLString x
EightOf9 (X.True ) -> accept PLBool P.True
NineOf9 (X.False ) -> accept PLBool P.False
where
accept :: (a -> c) -> a -> Either b c
accept con = Right . con
reject :: (a -> b) -> a -> Either b c
reject con = Left . con
tryRead :: Read a => (a -> c) -> (String -> b) -> String -> Either b c
tryRead onGood onBad str =
case reads str of
((result, ""):_) -> accept onGood result
_ -> reject onBad str
instance PListCoalgebra (Either PlistItem) PlistItem where
plistCoalgebra = (unparsedPlistItemToPlistItem +++ id) . plistCoalgebra
instance PListCoalgebra Maybe PlistItem where
plistCoalgebra = either (const Nothing) Just . (plistCoalgebra :: PlistItem -> Either PlistItem (PropertyListS PlistItem))
instance PListCoalgebra f PlistItem => PListCoalgebra f Plist where
plistCoalgebra = fmap (fmap plistItemToPlist) . plistCoalgebra . plistToPlistItem
unparsedPlistItemToPlistItem :: UnparsedPlistItem -> PlistItem
unparsedPlistItemToPlistItem = $(fold ''UnparsedPlistItem)
(TwoOf9 . Data )
(ThreeOf9 . Date )
(SixOf9 . AInteger)
(FiveOf9 . AReal )