From 88747f2463963ff2895a597b3054b12b2288530e Mon Sep 17 00:00:00 2001 From: PHO Date: Fri, 29 Jul 2011 23:13:40 +0900 Subject: [PATCH] Fixing build breakage... Ditz-issue: 1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0 --- Rakka.cabal | 53 +++++---- Rakka/Attachment.hs | 2 - Rakka/Authorization.hs | 2 - Rakka/Environment.hs | 2 - Rakka/Page.hs | 3 - Rakka/Resource.hs | 3 - Rakka/Resource/Object.hs | 2 - Rakka/Resource/PageEntity.hs | 3 - Rakka/Resource/Render.hs | 3 - Rakka/Resource/Search.hs | 3 - Rakka/Resource/SystemConfig.hs | 2 - Rakka/Resource/Users.hs | 2 - Rakka/Storage/DefaultPage.hs | 2 - Rakka/Storage/Repos.hs | 2 - Rakka/SystemConfig.hs | 2 - Rakka/Utils.hs | 101 ++++++++++-------- Rakka/Validation.hs | 5 - Rakka/Wiki/Engine.hs | 3 - Rakka/Wiki/Interpreter/Base.hs | 1 - ...bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml | 23 ++++ cabal-package.mk | 47 ++++++-- 21 files changed, 145 insertions(+), 121 deletions(-) create mode 100644 bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml diff --git a/Rakka.cabal b/Rakka.cabal index a634873..09d8c15 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -63,30 +63,32 @@ Flag build-test-suite Executable rakka Build-Depends: - HsHyperEstraier == 0.4.*, - HsOpenSSL == 0.10.*, - HsSVN == 0.4.*, - Lucu == 0.7.*, - base == 4.3.*, - bytestring == 0.9.*, - containers == 0.4.*, - dataenc == 0.14.*, - directory == 1.1.*, - filemanip == 0.3.*, - filepath == 1.2.*, - hslogger == 1.1.*, - hxt == 9.1.*, - hxt-xpath == 9.1.*, - magic == 1.0.*, - mtl == 2.0.*, - network == 2.3.*, - parsec == 3.1.*, - stm == 2.2.*, - time == 1.2.*, - time-http == 0.1.*, - time-w3c == 0.1.*, - unix == 2.4.*, - zlib == 0.5.* + HsHyperEstraier == 0.4.*, + HsOpenSSL == 0.10.*, + HsSVN == 0.4.*, + Lucu == 0.7.*, + base == 4.3.*, + base-unicode-symbols == 0.2.*, + bytestring == 0.9.*, + containers == 0.4.*, + dataenc == 0.14.*, + directory == 1.1.*, + filemanip == 0.3.*, + filepath == 1.2.*, + hslogger == 1.1.*, + hxt == 9.1.*, + hxt-xpath == 9.1.*, + magic == 1.0.*, + mtl == 2.0.*, + network == 2.3.*, + parsec == 3.1.*, + stm == 2.2.*, + text == 0.11.*, + time == 1.2.*, + time-http == 0.1.*, + time-w3c == 0.1.*, + unix == 2.4.*, + zlib == 0.5.* Main-Is: Main.hs @@ -106,7 +108,6 @@ Executable rakka Rakka.Resource.Render Rakka.Resource.Search Rakka.Resource.SystemConfig - Rakka.Resource.TrackBack Rakka.Resource.Users Rakka.Storage Rakka.Storage.DefaultPage @@ -114,7 +115,6 @@ Executable rakka Rakka.Storage.Types Rakka.Storage.Impl Rakka.SystemConfig - Rakka.TrackBack Rakka.Utils Rakka.Validation Rakka.Wiki @@ -122,7 +122,6 @@ Executable rakka Rakka.Wiki.Interpreter.Base Rakka.Wiki.Interpreter.Image Rakka.Wiki.Interpreter.PageList - Rakka.Wiki.Interpreter.Trackback Rakka.Wiki.Interpreter.Outline Rakka.Wiki.Engine Rakka.Wiki.Formatter diff --git a/Rakka/Attachment.hs b/Rakka/Attachment.hs index 06a9476..1e6d862 100644 --- a/Rakka/Attachment.hs +++ b/Rakka/Attachment.hs @@ -2,14 +2,12 @@ module Rakka.Attachment ( Attachment(..) ) where - import Control.Arrow import Control.Arrow.ArrowList import System.IO.Unsafe import Text.XML.HXT.Arrow.ReadDocument import Text.XML.HXT.Arrow.WriteDocument import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.DOM.TypeDefs import Text.XML.HXT.DOM.XmlKeywords diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs index 97927c5..d4da7db 100644 --- a/Rakka/Authorization.hs +++ b/Rakka/Authorization.hs @@ -7,8 +7,6 @@ module Rakka.Authorization , delUser ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import Control.Concurrent.STM import Control.Monad import Control.Monad.Trans diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 8d3c16c..9a6df3a 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -19,14 +19,12 @@ import Rakka.Wiki.Interpreter import qualified Rakka.Wiki.Interpreter.Base as Base import qualified Rakka.Wiki.Interpreter.Image as Image import qualified Rakka.Wiki.Interpreter.PageList as PageList ---import qualified Rakka.Wiki.Interpreter.Trackback as Trackback import qualified Rakka.Wiki.Interpreter.Outline as Outline import Subversion.Repository import System.Directory import System.FilePath import System.Log.Logger import Text.HyperEstraier -import Text.XML.HXT.Arrow.XmlIOStateArrow logger :: String diff --git a/Rakka/Page.hs b/Rakka/Page.hs index f0a7a77..e396c1b 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -27,8 +27,6 @@ module Rakka.Page , parseXmlizedPage ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as L hiding (ByteString) import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) @@ -43,7 +41,6 @@ import OpenSSL.EVP.Base64 import Rakka.Utils import Subversion.Types import System.FilePath.Posix -import Text.XML.HXT.Arrow import Text.XML.HXT.XPath diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs index c589cec..a1c4d90 100644 --- a/Rakka/Resource.hs +++ b/Rakka/Resource.hs @@ -9,8 +9,6 @@ module Rakka.Resource , getUserID ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import Control.Arrow import Control.Arrow.ArrowList import Control.Monad @@ -25,7 +23,6 @@ import System.FilePath.Posix import System.Log.Logger import Text.XML.HXT.Arrow.ReadDocument import Text.XML.HXT.Arrow.WriteDocument -import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.DOM.TypeDefs import Text.XML.HXT.DOM.XmlKeywords diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs index d4db7db..8365381 100644 --- a/Rakka/Resource/Object.hs +++ b/Rakka/Resource/Object.hs @@ -3,8 +3,6 @@ module Rakka.Resource.Object ( resObject ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import Network.HTTP.Lucu import Rakka.Environment import Rakka.Page diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index 7476d0e..c805ae5 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -2,8 +2,6 @@ module Rakka.Resource.PageEntity ( fallbackPageEntity ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import Control.Monad.Trans import qualified Data.ByteString.Lazy as L hiding (ByteString) import Data.Char @@ -22,7 +20,6 @@ import Rakka.Utils import Rakka.Wiki.Engine import System.FilePath.Posix import Text.HyperEstraier hiding (getText) -import Text.XML.HXT.Arrow import Text.XML.HXT.XPath diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs index 64c159e..8202cf6 100644 --- a/Rakka/Resource/Render.hs +++ b/Rakka/Resource/Render.hs @@ -2,8 +2,6 @@ module Rakka.Resource.Render ( resRender ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import Control.Arrow import Control.Arrow.ArrowIO import Control.Arrow.ArrowList @@ -19,7 +17,6 @@ import System.FilePath.Posix import Text.XML.HXT.Arrow.Namespace import Text.XML.HXT.Arrow.WriteDocument import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.DOM.TypeDefs import Text.XML.HXT.DOM.XmlKeywords diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs index 0543684..eb4acf2 100644 --- a/Rakka/Resource/Search.hs +++ b/Rakka/Resource/Search.hs @@ -2,8 +2,6 @@ module Rakka.Resource.Search ( resSearch ) where - -import qualified Codec.Binary.UTF8.Generic as UTF8 import Control.Monad.Trans import Data.List import Data.Maybe @@ -21,7 +19,6 @@ import Rakka.Utils import Rakka.Wiki.Engine import System.FilePath import Text.HyperEstraier hiding (getText) -import Text.XML.HXT.Arrow import Text.XML.HXT.XPath diff --git a/Rakka/Resource/SystemConfig.hs b/Rakka/Resource/SystemConfig.hs index cb19011..100fd12 100644 --- a/Rakka/Resource/SystemConfig.hs +++ b/Rakka/Resource/SystemConfig.hs @@ -2,13 +2,11 @@ module Rakka.Resource.SystemConfig ( resSystemConfig ) where - import Data.Maybe import Network.HTTP.Lucu import Rakka.Environment import Rakka.Resource import Rakka.SystemConfig -import Text.XML.HXT.Arrow import Text.XML.HXT.XPath diff --git a/Rakka/Resource/Users.hs b/Rakka/Resource/Users.hs index fa61ad8..ccf677c 100644 --- a/Rakka/Resource/Users.hs +++ b/Rakka/Resource/Users.hs @@ -2,7 +2,6 @@ module Rakka.Resource.Users ( resUsers ) where - import Control.Monad import Control.Monad.Trans import Data.Maybe @@ -10,7 +9,6 @@ import Network.HTTP.Lucu import Rakka.Authorization import Rakka.Environment import Rakka.Resource -import Text.XML.HXT.Arrow hiding (when) resUsers :: Environment -> ResourceDef diff --git a/Rakka/Storage/DefaultPage.hs b/Rakka/Storage/DefaultPage.hs index e6f51a5..a6fbc10 100644 --- a/Rakka/Storage/DefaultPage.hs +++ b/Rakka/Storage/DefaultPage.hs @@ -4,7 +4,6 @@ module Rakka.Storage.DefaultPage , loadDefaultPage ) where - import Control.Arrow import Control.Arrow.ArrowIO import Control.Arrow.ArrowList @@ -18,7 +17,6 @@ import System.FilePath import System.FilePath.Find hiding (fileName, modificationTime) import System.Posix.Files import Text.XML.HXT.Arrow.ReadDocument -import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.DOM.XmlKeywords diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index 05d02c2..ae4ce70 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -10,8 +10,6 @@ module Rakka.Storage.Repos , putAttachmentIntoRepository ) where - -import Codec.Binary.UTF8.String import Control.Monad import Data.List import qualified Data.Map as M diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index 4978b46..c151427 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -21,8 +21,6 @@ module Rakka.SystemConfig , deserializeStringPairs ) where - -import Codec.Binary.UTF8.String import Control.Arrow.ArrowIO import Control.Concurrent.STM import Control.Monad diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs index 15bc6f4..9cc0698 100644 --- a/Rakka/Utils.hs +++ b/Rakka/Utils.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + Arrows + , UnicodeSyntax + #-} module Rakka.Utils ( yesOrNo , trueOrFalse @@ -10,80 +14,85 @@ module Rakka.Utils , mkQueryString ) where - -import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Arrow -import Control.Arrow.ArrowList -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) -import Magic -import Network.HTTP.Lucu -import Network.URI -import System.IO.Unsafe - - -yesOrNo :: Bool -> String +import qualified Codec.Binary.Url as Url +import Control.Arrow +import Control.Arrow.ArrowList +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LS +import qualified Data.ByteString.Lazy.Char8 as L8 +import Data.List +import qualified Data.Text as T +import Data.Text.Encoding +import Network.HTTP.Lucu +import Network.URI +import Prelude.Unicode +import System.IO.Unsafe + + +yesOrNo ∷ Bool → String yesOrNo True = "yes" yesOrNo False = "no" -trueOrFalse :: Bool -> String +trueOrFalse ∷ Bool → String trueOrFalse True = "true" trueOrFalse False = "false" -parseYesOrNo :: ArrowChoice a => a String Bool +parseYesOrNo ∷ ArrowChoice a => a String Bool parseYesOrNo - = proc str -> do case str of - "yes" -> returnA -< True - "no" -> returnA -< False - _ -> returnA -< error ("Expected yes or no: " ++ str) + = proc str → do case str of + "yes" → returnA -< True + "no" → returnA -< False + _ → returnA -< error ("Expected yes or no: " ⧺ str) -maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c) +maybeA ∷ (ArrowList a, ArrowChoice a) => a b c → a b (Maybe c) maybeA a = listA a >>> - proc xs -> case xs of - [] -> returnA -< Nothing - (x:_) -> returnA -< Just x + proc xs → case xs of + [] → returnA -< Nothing + (x:_) → returnA -< Just x -deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String +deleteIfEmpty ∷ (ArrowList a, ArrowChoice a) => a String String deleteIfEmpty - = proc str -> do case str of - "" -> none -< () - _ -> returnA -< str + = proc str → do case str of + "" → none -< () + _ → returnA -< str -chomp :: String -> String +chomp ∷ String → String chomp = reverse . snd . break (/= '\n') . reverse -guessMIMEType :: Lazy.ByteString -> MIMEType +guessMIMEType ∷ LS.ByteString → MIMEType guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack where - magic :: Magic + magic ∷ Magic magic = unsafePerformIO $ do m <- magicOpen [MagicMime] magicLoadDefault m return m -isSafeChar :: Char -> Bool +isSafeChar ∷ Char → Bool isSafeChar c - | c == '/' = True - | isReserved c = False - | c > ' ' && c <= '~' = True - | otherwise = False - - -mkQueryString :: [(String, String)] -> String -mkQueryString [] = "" -mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++ - if xs == [] then - "" - else - ';' : mkQueryString(xs) + | c ≡ '/' = True + | isReserved c = False + | isUnreserved c = True + | otherwise = False + + +mkQueryString ∷ [(T.Text, T.Text)] → String +{-# INLINEABLE mkQueryString #-} +mkQueryString = intercalate ";" ∘ map pairToStr where - encode :: String -> String - encode = escapeURIString isSafeChar . UTF8.encodeString \ No newline at end of file + pairToStr ∷ (T.Text, T.Text) → String + {-# INLINE pairToStr #-} + pairToStr (k, v) + = encode k ⧺ ('=':encode v) + + encode ∷ T.Text → String + {-# INLINE encode #-} + encode = Url.encode ∘ BS.unpack ∘ encodeUtf8 diff --git a/Rakka/Validation.hs b/Rakka/Validation.hs index 73a83e7..70129a4 100644 --- a/Rakka/Validation.hs +++ b/Rakka/Validation.hs @@ -2,7 +2,6 @@ module Rakka.Validation ( getValidator ) where - import Control.Arrow import Control.Arrow.ArrowList import Control.Arrow.ArrowTree @@ -12,11 +11,7 @@ import Rakka.Environment import System.Directory import System.FilePath import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.DOM.TypeDefs -import qualified Text.XML.HXT.RelaxNG.Schema as S -import Text.XML.HXT.RelaxNG.Validator - loadSchema :: FilePath -> IO (IOSArrow XmlTree XmlTree) loadSchema fpath diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index 17c2933..dae6471 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -7,8 +7,6 @@ module Rakka.Wiki.Engine , makeDraft ) where - -import qualified Codec.Binary.UTF8.String as UTF8 import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) import Data.Map (Map) @@ -27,7 +25,6 @@ import Rakka.Wiki.Formatter import Rakka.Wiki.Interpreter import Text.HyperEstraier hiding (getText) import Text.ParserCombinators.Parsec -import Text.XML.HXT.Arrow hiding (err) import Text.XML.HXT.XPath diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index ed81494..1af5c77 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -10,7 +10,6 @@ import Rakka.Page import Rakka.SystemConfig import Rakka.Wiki import Rakka.Wiki.Interpreter -import Text.XML.HXT.Arrow import Text.XML.HXT.XPath diff --git a/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml b/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml new file mode 100644 index 0000000..7a78767 --- /dev/null +++ b/bugs/issue-1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0.yaml @@ -0,0 +1,23 @@ +--- !ditz.rubyforge.org,2008-03-06/issue +title: Rakka is rather bitrotted +desc: We have to repair it ASAP. +type: :task +component: Rakka +release: "0.1" +reporter: PHO +status: :in_progress +disposition: +creation_time: 2011-07-29 14:12:39.862597 Z +references: [] + +id: 1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0 +log_events: +- - 2011-07-29 14:12:40.853438 Z + - PHO + - created + - "" +- - 2011-07-29 14:13:16.762514 Z + - PHO + - changed status from unstarted to in_progress + - I'm working on this... +git_branch: diff --git a/cabal-package.mk b/cabal-package.mk index d8bbaad..2363b98 100644 --- a/cabal-package.mk +++ b/cabal-package.mk @@ -14,11 +14,14 @@ RM_RF ?= rm -rf SUDO ?= sudo AUTOCONF ?= autoconf HLINT ?= hlint +HPC ?= hpc +DITZ ?= ditz CONFIGURE_ARGS ?= --disable-optimization SETUP_FILE := $(wildcard Setup.*hs) CABAL_FILE := $(wildcard *.cabal) +PKG_NAME := $(CABAL_FILE:.cabal=) ifeq ($(shell ls configure.ac 2>/dev/null),configure.ac) AUTOCONF_AC_FILE := configure.ac @@ -40,6 +43,7 @@ all: build build: setup-config build-hook ./Setup build + $(RM_RF) *.tix build-hook: @@ -70,7 +74,7 @@ Setup: $(SETUP_FILE) $(GHC) --make Setup clean: clean-hook - $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo + $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo *.tix .hpc $(FIND) . -name '*~' -exec rm -f {} \; clean-hook: @@ -85,11 +89,42 @@ sdist: setup-config ./Setup sdist test: build + $(RM_RF) dist/test ./Setup test + if ls *.tix >/dev/null 2>&1; then \ + $(HPC) sum --output="merged.tix" --union --exclude=Main *.tix; \ + $(HPC) markup --destdir="dist/hpc" --fun-entry-count "merged.tix"; \ + fi + +ditz: + $(DITZ) html dist/ditz + +fixme: + @$(FIND) . \ + \( -name 'dist' -or -name '.git' -or -name '_darcs' \) -prune \ + -or \ + \( -name '*.c' -or -name '*.h' -or \ + -name '*.hs' -or -name '*.lhs' -or \ + -name '*.hsc' -or -name '*.cabal' \) \ + -exec egrep -i '(fixme|thinkme)' {} \+ \ + || echo 'No FIXME or THINKME found.' lint: - $(HLINT) . --report \ - --ignore="Use string literal" \ - --ignore="Use concatMap" - -.PHONY: build build-hook setup-config setup-config-hook run clean clean-hook install doc sdist test lint + $(HLINT) . --report + +push: doc ditz + if [ -d "_darcs" ]; then \ + darcs push; \ + elif [ -d ".git" ]; then \ + git push --all && git push --tags; \ + fi + if [ -d "dist/doc" ]; then \ + rsync -av --delete \ + dist/doc/html/$(PKG_NAME)/ \ + www@nem.cielonegro.org:static.cielonegro.org/htdocs/doc/$(PKG_NAME); \ + fi + rsync -av --delete \ + dist/ditz/ \ + www@nem.cielonegro.org:static.cielonegro.org/htdocs/ditz/$(PKG_NAME) + +.PHONY: build build-hook setup-config setup-config-hook run clean clean-hook install doc sdist test lint push -- 2.40.0