From 935d5dc1c8d4c60a70d79a3f47718f9dcf5684fd Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 3 Aug 2022 12:51:13 -0400
Subject: Key analyses on Namespace, not FilePath

Namespace is unique, whereas FilePath could be relative or absolute, or have a
leading . or trailing / or not.
---
 Biz/Namespace.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

(limited to 'Biz/Namespace.hs')

diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index 6fb40f7..cdc4464 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -37,10 +38,10 @@ data Ext
   | Rs
   | Scm
   | Sh
-  deriving (Eq, Show, Generic, Aeson.ToJSON)
+  deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
 
 data Namespace = Namespace {path :: [String], ext :: Ext}
-  deriving (Eq, Show, Generic, Aeson.ToJSON)
+  deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
 
 fromPath :: String -> String -> Maybe Namespace
 fromPath bizRoot absPath =
@@ -50,9 +51,24 @@ fromPath bizRoot absPath =
 
 toPath :: Namespace -> FilePath
 toPath (Namespace parts ext) =
-  joinWith "/" parts
-    <> "."
-    <> lowercase (show ext)
+  joinWith "/" parts <> toExt ext
+
+toExt :: Ext -> String
+toExt =
+  ("." <>) <. \case
+    C -> "c"
+    Css -> "css"
+    Hs -> "hs"
+    Json -> "json"
+    Keys -> "pub"
+    Lisp -> "lisp"
+    Md -> "md"
+    Nix -> "nix"
+    None -> "none"
+    Py -> "py"
+    Rs -> "rs"
+    Scm -> "scm"
+    Sh -> "sh"
 
 fromHaskellContent :: String -> Maybe Namespace
 fromHaskellContent c = case Regex.findFirstInfix haskellModule c of
-- 
cgit v1.2.3