Commits

Peter Sagerson committed 797096e

Use newtype for ViewMap and ViewReduce for better encapsulation.

  • Participants
  • Parent commits d50ab60

Comments (0)

Files changed (7)

source/Database/CouchDB/ViewServer.hs

 {- |
-    This ia a CouchDB view server in and for Haskell. With it, you can define
+    This is a CouchDB view server in and for Haskell. With it, you can define
     design documents that use Haskell functions to perform map/reduce
     operations. Database.CouchDB.ViewServer is just a container; see the
     submodules for API documentation.
     In addition to the server mode, @couch-hs@ has some special modes to aid
     development. CouchDB isn't very good at reporting errors in view functions,
     so the following modes can be used to make sure your functions compile
-    before installing them into a view. To ensure valid results, be sure to
-    match the @couch-hs@ options with those in CouchDB's config file.
+    before installing them into a view. These can be run manually, although
+    they're especially useful when integrated into your editor. They can also
+    serve as a sanity check in your deployment process. To ensure valid results,
+    be sure to match the @couch-hs@ options with those in CouchDB's config file.
 
     [@couch-hs \[options\] -M \[CODE|\@PATH\] ...@] Attempt to compile one or
     more map functions. Each argument can either be a source string or a path to

source/Database/CouchDB/ViewServer/Internal.hs

-{-# OPTIONS_HADDOCK hide #-}
-
 module Database.CouchDB.ViewServer.Internal where
 
 import Data.Aeson

source/Database/CouchDB/ViewServer/Main/Server/Command.hs

                 String "reduce"   -> parseReduce args
                 String "rereduce" -> parseRereduce args
                 String s          -> fail $ "Unrecognized view command: " ++ unpack s
+                _                 -> typeMismatch "view command" value
         | otherwise = typeMismatch "view command" value
         where
             args :: [Value]

source/Database/CouchDB/ViewServer/Map.hs

-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 module Database.CouchDB.ViewServer.Map
 import Data.Text (Text, unpack)
 
 import Control.Applicative
+import Control.Monad (Monad, MonadPlus)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Writer (WriterT, tell, execWriterT)
 
     Emit Value Value |
     Log LogMessage
 
-type ViewMapT m a = WriterT [MapOutput] m a
-
 
 {- | The monad within which a map computation takes place. This is a
-     transformation of the 'Data.Aeson.Types.Parser' monad, although the precise
-     nature and depth of the transformation is an internal detail and subject to
-     change. ViewMapT is guaranteed to be an instance of the 'MonadParser'
-     class, allowing you to parse JSON structures.
+     transformation of the 'Data.Aeson.Types.Parser' monad, which is accessible
+     through the 'MonadParser' typeclass.
 -}
-type ViewMap a = ViewMapT Parser a
+newtype ViewMap a = ViewMap { runViewMap :: WriterT [MapOutput] Parser a }
+    deriving(Monad, Functor, MonadPlus, Applicative, Alternative)
+
+instance MonadParser ViewMap where
+    liftParser = ViewMap . lift
 
 
 {- | The type of your map functions as they are stored in CouchDB. The trivial
 
 
 execMapFunc :: MapFunc -> Object -> [MapOutput]
-execMapFunc mapFunc doc = fromMaybe [] $ parseMaybe execWriterT (runMapFunc mapFunc doc)
+execMapFunc mapFunc doc = fromMaybe [] $ parseMaybe execWriterT (runViewMap $ runMapFunc mapFunc doc)
 
 
 emits :: [MapOutput] -> [MapOutput]
 -}
  
 emit :: (ToJSON k, ToJSON v) => k -> v -> ViewMap ()
-emit key value = tell [Emit (toJSON key) (toJSON value)]
+emit key value = ViewMap $ tell [Emit (toJSON key) (toJSON value)]
 
 
 {- | Same as 'emit', but with wrapped key and value.
      of a failure, look at 'Control.Applicative.Alternative'.
 -}
 logMsg :: String -> ViewMap ()
-logMsg msg = tell [Log $ LogMessage msg]
+logMsg msg = ViewMap $ tell [Log $ LogMessage msg]

source/Database/CouchDB/ViewServer/Parse.hs

-{-# OPTIONS_HADDOCK hide #-}
-
 module Database.CouchDB.ViewServer.Parse
     (
 {- |
 instance MonadParser Parser where
     liftParser = id
 
-instance (Monoid w, MonadParser m) => MonadParser (WriterT w m) where
-    liftParser = lift . liftParser
-
 
 {- | Attempts to parse a JSON value into a given type. This is typically used
      with a type annotation to indicate the target type. If the value can not

source/Database/CouchDB/ViewServer/Reduce.hs

-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 module Database.CouchDB.ViewServer.Reduce
 import Data.Aeson.Types (Value(..), Object, Parser, parseMaybe)
 
 import Control.Applicative
+import Control.Monad (Monad, MonadPlus)
+import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Writer (WriterT, tell, runWriterT)
 import qualified Language.Haskell.Interpreter as H
 
 
 type ReduceOutput = (Value, [LogMessage])
 
-type ViewReduceT m a = WriterT [LogMessage] m a
-
 
 {- | The monad within which a reduce computation takes place. This is a
-     transformation of the 'Data.Aeson.Types.Parser' monad, although the precise
-     nature and depth of the transformation is an internal detail and subject to
-     change. ViewReduceT is guaranteed to be an instance of the 'MonadParser'
-     class, allowing you to parse JSON structures.
+     transformation of the 'Data.Aeson.Types.Parser' monad, which is accessible
+     through the 'MonadParser' typeclass.
 -}
-type ViewReduce a = ViewReduceT Parser a
+newtype ViewReduce a = ViewReduce { runViewReduce :: WriterT [LogMessage] Parser a }
+    deriving(Monad, Functor, MonadPlus, Applicative, Alternative)
+
+instance MonadParser ViewReduce where
+    liftParser = ViewReduce . lift
 
 
 {- | The type of your reduce functions as they are stored in CouchDB. The trivial
 
 
 execReduceFunc :: ReduceFunc -> [Value] -> [Value] -> Bool -> ReduceOutput
-execReduceFunc reduceFunc keys values rereduce = fromMaybe (Null, []) $ parseMaybe runWriterT (runReduceFunc reduceFunc keys values rereduce)
+execReduceFunc reduceFunc keys values rereduce = fromMaybe (Null, []) $ parseMaybe runWriterT (runViewReduce $ runReduceFunc reduceFunc keys values rereduce)
 
 
 {- | Send a log message to the CouchDB server. Note that log messages are only
      of a failure, look at 'Control.Applicative.Alternative'.
 -}
 logMsg :: String -> ViewReduce ()
-logMsg msg = tell [LogMessage msg]
+logMsg msg = ViewReduce $ tell [LogMessage msg]
-#!/usr/bin/env runhaskell
-
 module Main where