Fix PathPiece for ZIPArchiveName & submission original archive link

src/Model/Types.hs

@@ -285,15 +285,12 @@ instance Default Theme where
 derivePersistField "Theme"
 
 
-newtype ZIPArchiveName obj = ZIPArchiveName obj
+newtype ZIPArchiveName obj = ZIPArchiveName { unZIPArchiveName :: obj }
   deriving (Show, Read, Eq)
 
 instance PathPiece obj => PathPiece (ZIPArchiveName obj) where
-    fromPathPiece (map CI.mk . unpack -> s)
-      | Just s' <- stripSuffix (map CI.mk ".zip") s = fromPathPiece . pack $ map CI.original s'
-      | otherwise = Nothing
-
-    toPathPiece (ZIPArchiveName obj) = toPathPiece obj <> ".zip"
+    fromPathPiece = fmap ZIPArchiveName . fromPathPiece <=< (stripSuffix `on` CI.foldCase) ".zip"
+    toPathPiece = (<> ".zip") . toPathPiece . unZIPArchiveName
 
 newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
   deriving (Eq, Ord, Read, Show, ToJSON, FromJSON, PersistField, PersistFieldSql)

templates/submission.hamlet

@@ -1,7 +1,8 @@
 $maybe cID <- mcid
-  <section style="padding-bottom:1em; margin-bottom:1em; border-bottom:1px solid black;">
+  <section>
     <h2>
       <a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
+      (<a href=@{CSubmissionR tid csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
     $if not (null lastEdits)
       <h3>_{MsgLastEdits}
       <ul>