1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Biz.Namespace
( Namespace (..),
Ext (..),
fromPath,
toPath,
fromHaskellContent,
fromHaskellModule,
toHaskellModule,
toSchemeModule,
isCab,
)
where
import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.List.Split as List
import qualified Text.Regex.Applicative as Regex
data Ext
= C
| Css
| Hs
| Json
| Keys
| Lisp
| Md
| Nix
| None
| Py
| Rs
| Scm
| Sh
deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
data Namespace = Namespace {path :: [String], ext :: Ext}
deriving (Eq, Show, Generic, Aeson.ToJSON, Ord)
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"
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
Nothing -> Nothing
Just (_, Namespace {..}, _) -> Just <| Namespace (filter (/= ".") path) ext
where
haskellModule =
Namespace
</ (Regex.string "\nmodule " *> Regex.many (name <|> dot))
<*> pure Hs
toHaskellModule :: Namespace -> String
toHaskellModule (Namespace parts Hs) = joinWith "." parts
toHaskellModule (Namespace {..}) =
panic <| "can't convert " <> show ext <> " to a Haskell module"
fromHaskellModule :: String -> Namespace
fromHaskellModule s = Namespace (List.splitOn "." s) Hs
toSchemeModule :: Namespace -> String
toSchemeModule (Namespace parts Scm) = "(" ++ joinWith " " parts ++ ")"
toSchemeModule (Namespace {..}) =
panic <| "can't convert " <> show ext <> " to a Scheme module"
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 Char.isAlphaNum)
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"
<|> 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"
-- | The cab dir is for temporary files and build outputs, not for source
-- inputs.
isCab :: FilePath -> Bool
isCab ('_' : _) = True
isCab fp = "_" `List.isInfixOf` fp
|
