summaryrefslogtreecommitdiff
path: root/Biz/Namespace.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Namespace.hs')
-rw-r--r--Biz/Namespace.hs170
1 files changed, 0 insertions, 170 deletions
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
deleted file mode 100644
index aa69a9c..0000000
--- a/Biz/Namespace.hs
+++ /dev/null
@@ -1,170 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Biz.Namespace
- ( Namespace (..),
- Ext (..),
- fromPath,
- toPath,
- toModule,
- fromHaskellContent,
- fromHaskellModule,
- toHaskellModule,
- toSchemeModule,
- fromPythonModule,
- isCab,
- groupByExt,
- )
-where
-
-import Alpha
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import qualified Data.Char as Char
-import qualified Data.List as List
-import qualified Data.List.Split as List
-import qualified Data.Map as Map
-import qualified Data.Text as Text
-import qualified Text.Regex.Applicative as Regex
-
-data Ext
- = C
- | Css
- | Hs
- | Html
- | Json
- | Keys
- | Lisp
- | Md
- | Nix
- | None
- | Py
- | Rs
- | Scm
- | Sh
- | Toml
- deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
-
-data Namespace = Namespace {path :: [String], ext :: Ext}
- deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
-
-instance Aeson.ToJSONKey Namespace where
- toJSONKey = Aeson.toJSONKeyText (Text.pack <. toPath)
-
-fromPath :: String -> String -> Maybe Namespace
-fromPath bizRoot absPath =
- List.stripPrefix bizRoot absPath
- +> List.stripPrefix "/"
- +> Regex.match (Namespace </ rePath <* dot <*> reExt)
-
-toPath :: Namespace -> FilePath
-toPath (Namespace parts ext) =
- joinWith "/" parts <> toExt ext
-
-toExt :: Ext -> String
-toExt =
- ("." <>) <. \case
- C -> "c"
- Css -> "css"
- Hs -> "hs"
- Html -> "html"
- Json -> "json"
- Keys -> "pub"
- Lisp -> "lisp"
- Md -> "md"
- Nix -> "nix"
- None -> "none"
- Py -> "py"
- Rs -> "rs"
- Scm -> "scm"
- Sh -> "sh"
- Toml -> "toml"
-
-fromHaskellContent :: String -> Maybe Namespace
-fromHaskellContent c = case Regex.findFirstInfix haskellModule c of
- Nothing -> Nothing
- Just (_, Namespace {..}, _) -> Just <| Namespace (filter (/= ".") path) ext
- where
- haskellModule =
- Namespace
- </ (Regex.string "\nmodule " *> Regex.many (name <|> dot))
- <*> pure Hs
-
-toModule :: Namespace -> String
-toModule (Namespace parts Hs) = joinWith "." parts
-toModule (Namespace parts Py) = joinWith "." parts
-toModule (Namespace parts Scm) = "(" ++ joinWith " " parts ++ ")"
-toModule (Namespace parts Rs) = joinWith "::" parts
-toModule (Namespace parts C) = joinWith "/" parts <> ".c"
-toModule (Namespace parts Nix) = joinWith "/" parts <> ".nix"
-toModule (Namespace {..}) = panic <| "toModule not implemented for " <> show ext
-
-toHaskellModule :: Namespace -> String
-toHaskellModule = toModule
-
-fromHaskellModule :: String -> Namespace
-fromHaskellModule s = Namespace (List.splitOn "." s) Hs
-
-toSchemeModule :: Namespace -> String
-toSchemeModule = toModule
-
-fromPythonModule :: String -> Namespace
-fromPythonModule s = Namespace (List.splitOn "." s) Py
-
-dot :: Regex.RE Char String
-dot = Regex.some <| Regex.sym '.'
-
-name :: Regex.RE Char String
-name =
- Regex.many (Regex.psym Char.isUpper)
- <> ( Regex.many
- <| Regex.psym
- <| \c -> Char.isAlphaNum c || c == '_' || c == '-'
- )
-
-rePath :: Regex.RE Char [String]
-rePath = Regex.many (name <* Regex.string "/" <|> name)
-
-reExt :: Regex.RE Char Ext
-reExt =
- C
- <$ Regex.string "c"
- <|> Css
- <$ Regex.string "css"
- <|> Hs
- <$ Regex.string "hs"
- <|> Html
- <$ Regex.string "html"
- <|> Json
- <$ Regex.string "json"
- <|> Keys
- <$ Regex.string "pub"
- <|> Lisp
- <$ Regex.string "lisp"
- <|> Md
- <$ Regex.string "md"
- <|> Nix
- <$ Regex.string "nix"
- <|> Py
- <$ Regex.string "py"
- <|> Rs
- <$ Regex.string "rs"
- <|> Scm
- <$ Regex.string "scm"
- <|> Sh
- <$ Regex.string "sh"
- <|> Toml
- <$ Regex.string "toml"
-
--- | The cab dir is for temporary files and build outputs, not for source
--- inputs.
-isCab :: FilePath -> Bool
-isCab ('_' : _) = True
-isCab fp = "/_/" `List.isInfixOf` fp
-
--- | Group a list of Namespaces keyed by their extensions
-groupByExt :: [Namespace] -> Map Ext [Namespace]
-groupByExt ns's = Map.fromListWith (++) [(ext ns, [ns]) | ns <- ns's]