From b7d905bb9034a4f21fa3889e83abff918c43cb58 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Tue, 29 Nov 2011 21:39:43 +0900
Subject: [PATCH] It must be a bad idea to expose overlapped orphan instances.

Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a
---
 Network/HTTP/Lucu/Implant/PrettyPrint.hs      |  1 -
 Network/HTTP/Lucu/MIMEParams/Internal.hs      |  4 +++-
 Network/HTTP/Lucu/OrphanInstances.hs          | 17 ++++++++++-------
 ...1be0bc848dbefccc5cea88e5c9339083d97ee.yaml | 19 +++++++++++++++++++
 examples/Makefile                             |  4 ++--
 5 files changed, 34 insertions(+), 11 deletions(-)
 create mode 100644 bugs/issue-ce71be0bc848dbefccc5cea88e5c9339083d97ee.yaml

diff --git a/Network/HTTP/Lucu/Implant/PrettyPrint.hs b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
index bcb6f04..f5376f1 100644
--- a/Network/HTTP/Lucu/Implant/PrettyPrint.hs
+++ b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
@@ -237,7 +237,6 @@ rules = [ qualifyAll   "Codec.Compression.GZip"              "G"
         , unqualifyAll "Network.HTTP.Lucu.ETag"              "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.Resource"          "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.Resource.Internal" "Network.HTTP.Lucu"
-        , unqualifyAll "Network.HTTP.Lucu.MIMEParams"        "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.MIMEType"          "Network.HTTP.Lucu"
         , unqualify    'when                                 "Control.Monad"
         , unqualify    'mempty                               "Data.Monoid"
diff --git a/Network/HTTP/Lucu/MIMEParams/Internal.hs b/Network/HTTP/Lucu/MIMEParams/Internal.hs
index b863f0f..a525375 100644
--- a/Network/HTTP/Lucu/MIMEParams/Internal.hs
+++ b/Network/HTTP/Lucu/MIMEParams/Internal.hs
@@ -11,10 +11,12 @@ import qualified Data.Map as M (Map)
 import Data.Monoid
 import Data.Text (Text)
 import Data.Typeable
+import Language.Haskell.TH.Syntax
+import Network.HTTP.Lucu.OrphanInstances ()
 
 -- |A 'Map' from MIME parameter attributes to values. Attributes are
 -- always case-insensitive according to RFC 2045
 -- (<http://tools.ietf.org/html/rfc2045#section-5.1>).
 newtype MIMEParams
     = MIMEParams (M.Map CIAscii Text)
-    deriving (Eq, Show, Read, Monoid, Typeable)
+    deriving (Eq, Show, Read, Lift, Monoid, Typeable)
diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs
index 47db98b..333e162 100644
--- a/Network/HTTP/Lucu/OrphanInstances.hs
+++ b/Network/HTTP/Lucu/OrphanInstances.hs
@@ -1,10 +1,9 @@
 {-# LANGUAGE
     FlexibleContexts
   , FlexibleInstances
-  , OverlappingInstances
   , RecordWildCards
+  , ScopedTypeVariables
   , TemplateHaskell
-  , UndecidableInstances
   , UnicodeSyntax
   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -22,6 +21,7 @@ import Data.CaseInsensitive (CI, FoldCase)
 import qualified Data.CaseInsensitive as CI
 import Data.Collections
 import Data.Collections.BaseInstances ()
+import qualified Data.Map as M
 import Data.Ratio
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -49,12 +49,15 @@ instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
 instance Lift Text where
     lift t = [| T.pack $(litE ∘ stringL $ T.unpack t) |]
 
-instance (Lift k, Lift v, Collection c (k, v)) ⇒ Lift c where
-    lift c
-        | null c    = [| empty |]
-        | otherwise = [| fromList $(liftPairs (fromFoldable c)) |]
+instance (Lift k, Lift v) ⇒ Lift (M.Map k v) where
+    lift m
+        | null m    = [| empty |]
+        | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
         where
-          liftPairs       = listE ∘ (liftPair <$>)
+          liftPairs ∷ [(k, v)] → Q Exp
+          liftPairs = listE ∘ (liftPair <$>)
+
+          liftPair ∷ (k, v) → Q Exp
           liftPair (k, v) = tupE [lift k, lift v]
 
 instance Lift UTCTime where
diff --git a/bugs/issue-ce71be0bc848dbefccc5cea88e5c9339083d97ee.yaml b/bugs/issue-ce71be0bc848dbefccc5cea88e5c9339083d97ee.yaml
new file mode 100644
index 0000000..87e8382
--- /dev/null
+++ b/bugs/issue-ce71be0bc848dbefccc5cea88e5c9339083d97ee.yaml
@@ -0,0 +1,19 @@
+--- !ditz.rubyforge.org,2008-03-06/issue 
+title: Remove deps on HXT
+desc: It's an overkill to use HXT to generate default pages.
+type: :task
+component: Lucu
+release: Lucu-1.0
+reporter: PHO <pho@cielonegro.org>
+status: :unstarted
+disposition: 
+creation_time: 2011-11-29 12:14:42.124430 Z
+references: []
+
+id: ce71be0bc848dbefccc5cea88e5c9339083d97ee
+log_events: 
+- - 2011-11-29 12:14:43.052342 Z
+  - PHO <pho@cielonegro.org>
+  - created
+  - ""
+git_branch: 
diff --git a/examples/Makefile b/examples/Makefile
index 606117f..c9a0cb4 100644
--- a/examples/Makefile
+++ b/examples/Makefile
@@ -25,11 +25,11 @@ clean:
 Implanted.hs: dist/MiseRafturai.hs
 dist/MiseRafturai.hs: mise-rafturai.html $(IMPLANT)
 	mkdir -p dist
-	$(IMPLANT) -m MiseRafturai -o $@ $<
+	$(IMPLANT) -m MiseRafturai -o $@ $< || (rm -f $@; exit 1)
 
 ImplantedSmall.hs: dist/SmallFile.hs
 dist/SmallFile.hs: small-file.txt $(IMPLANT)
 	mkdir -p dist
-	$(IMPLANT) -m SmallFile -t "text/plain; charset=\"UTF-8\"" -o $@ $<
+	$(IMPLANT) -m SmallFile -t "text/plain; charset=\"UTF-8\"" -o $@ $< || (rm -f $@; exit 1)
 
 .PHONY: build run clean
-- 
2.40.0