summaryrefslogtreecommitdiff
path: root/Text/OPML/Conduit/Render.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Text/OPML/Conduit/Render.hs')
-rw-r--r--Text/OPML/Conduit/Render.hs18
1 files changed, 7 insertions, 11 deletions
diff --git a/Text/OPML/Conduit/Render.hs b/Text/OPML/Conduit/Render.hs
index 9786203..611926d 100644
--- a/Text/OPML/Conduit/Render.hs
+++ b/Text/OPML/Conduit/Render.hs
@@ -16,7 +16,6 @@ import Control.Monad
import Data.Conduit
import Data.List.NonEmpty hiding (filter, map)
import Data.Monoid
-import Data.NonNull
import Data.String
import Data.Text (Text, intercalate, pack, toLower)
import Data.Text.Encoding
@@ -26,16 +25,13 @@ import Data.Time.RFC822
import Data.Tree
import Data.Version
import Data.XML.Types
-
import Lens.Simple
-
import Prelude hiding (foldr, lookup, show)
import qualified Prelude (show)
-
+import Refined hiding (NonEmpty)
import Text.OPML.Lens
import Text.OPML.Types
import Text.XML.Stream.Render
-
import URI.ByteString
-- }}}
@@ -52,8 +48,8 @@ toMaybe s | s == mempty = mempty
formatTime :: UTCTime -> Text
formatTime = formatTimeRFC822 . utcToZonedTime utc
-formatCategories :: [NonEmpty (NonNull Text)] -> Maybe Text
-formatCategories = toMaybe . intercalate "," . map (intercalate "/" . toList . fmap toNullable)
+formatCategories :: [NonEmpty (Refined (Not Null) Text)] -> Maybe Text
+formatCategories = toMaybe . intercalate "," . map (intercalate "/" . toList . fmap unrefine)
formatBool :: Bool -> Text
formatBool = toLower . show
@@ -62,7 +58,7 @@ formatURI :: URI -> Text
formatURI = decodeUtf8 . serializeURIRef'
-- | Render the @\<head\>@ section.
-renderOpmlHead :: (Monad m) => OpmlHead -> Source m Event
+renderOpmlHead :: (Monad m) => OpmlHead -> ConduitT () Event m ()
renderOpmlHead input = tag "head" mempty $ do
forM_ (input^.opmlCreatedL) $ tag "dateCreated" mempty . content . formatTime
forM_ (input^.modifiedL) $ tag "dateModified" mempty . content . formatTime
@@ -83,13 +79,13 @@ renderOpmlHead input = tag "head" mempty $ do
title = input ^. opmlTitleL
-- | Render an @\<outline\>@ section.
-renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> Source m Event
+renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> ConduitT () Event m ()
renderOpmlOutline (Node outline subOutlines) = tag "outline" attributes $ mapM_ renderOpmlOutline subOutlines
where attributes = case outline of
OpmlOutlineGeneric b t -> baseAttr b <> optionalAttr "type" (toMaybe t)
OpmlOutlineLink b uri -> baseAttr b <> attr "type" "link" <> attr "url" (formatURI uri)
OpmlOutlineSubscription b s -> baseAttr b <> subscriptionAttr s
- baseAttr b = attr "text" (toNullable $ b^.textL)
+ baseAttr b = attr "text" (unrefine $ b^.textL)
<> optionalAttr "isComment" (formatBool <$> b^.isCommentL)
<> optionalAttr "isBreakpoint" (formatBool <$> b^.isBreakpointL)
<> optionalAttr "created" (formatTime <$> b^.outlineCreatedL)
@@ -103,7 +99,7 @@ renderOpmlOutline (Node outline subOutlines) = tag "outline" attributes $ mapM_
<> optionalAttr "version" (toMaybe $ s^.subscriptionVersionL)
-- | Render the top-level @\<opml\>@ section.
-renderOpml :: (Monad m) => Opml -> Source m Event
+renderOpml :: Monad m => Opml -> ConduitT () Event m ()
renderOpml opml = tag "opml" (attr "version" . pack . showVersion $ opml^.opmlVersionL) $ do
renderOpmlHead $ opml^.opmlHeadL
tag "body" mempty . mapM_ renderOpmlOutline $ opml^.opmlOutlinesL