Skip to content
This repository was archived by the owner on Mar 17, 2021. It is now read-only.

Commit 9ac3173

Browse files
tarlebtarleb
committed
Add paths module
1 parent 1eafe35 commit 9ac3173

File tree

3 files changed

+208
-17
lines changed

3 files changed

+208
-17
lines changed

‎hslua-module-paths.cabal‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,10 @@ source-repository head
2626
location: https://github.com/hslua/hslua-module-paths.git
2727

2828
common common-options
29-
build-depends: base >= 4.9.1.0
29+
build-depends: base >= 4.9.1 && < 5
30+
, filepath >= 1.4 && < 1.5
31+
, hslua >= 1.2 && < 1.3
32+
, text >= 1.0 && < 1.3
3033

3134
ghc-options: -Wall
3235
-Wcompat
@@ -48,7 +51,7 @@ common common-options
4851
library
4952
import: common-options
5053
hs-source-dirs: src
51-
exposed-modules: HsluaModulePaths
54+
exposed-modules: Foreign.Lua.Module.Paths
5255

5356
test-suite hslua-module-paths-test
5457
import: common-options

‎src/Foreign/Lua/Module/Paths.hs‎

Lines changed: 203 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,203 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-|
3+
Module : Foreign.Lua.Module.Paths
4+
Copyright : © 2020 Albert Krewinkel
5+
License : MIT
6+
Maintainer : Albert Krewinkel <[email protected]>
7+
Stability : alpha
8+
Portability : Requires GHC 8 or later.
9+
10+
Lua module to work with file paths.
11+
-}
12+
module Foreign.Lua.Module.Paths (
13+
-- * Module
14+
pushModule
15+
, preloadModule
16+
, documentedModule
17+
18+
-- * Path manipulations
19+
, drop_extensions
20+
, has_extension
21+
, is_absolute
22+
, is_relative
23+
, join_path
24+
, normalise
25+
, split_directories
26+
, take_directory
27+
, take_extensions
28+
, take_filename
29+
)
30+
where
31+
32+
import Data.Text (Text)
33+
import Foreign.Lua (Lua, NumResults (..))
34+
import Foreign.Lua.Call
35+
import Foreign.Lua.Module hiding (preloadModule, pushModule)
36+
import Foreign.Lua.Peek (Peeker, peekList, peekString)
37+
import Foreign.Lua.Push (pushBool, pushList, pushString)
38+
39+
import qualified Data.Text as T
40+
import qualified Foreign.Lua.Module as Module
41+
import qualified System.FilePath as Path
42+
43+
--
44+
-- Module
45+
--
46+
47+
description :: Text
48+
description = "Access to system information and functionality."
49+
50+
fields :: [Field]
51+
fields = []
52+
53+
documentedModule :: Module
54+
documentedModule = Module
55+
{ moduleName = "paths"
56+
, moduleFields = fields
57+
, moduleDescription = description
58+
, moduleFunctions = functions
59+
}
60+
61+
-- | Pushes the @system@ module to the Lua stack.
62+
pushModule :: Lua NumResults
63+
pushModule = 1 <$ Module.pushModule documentedModule
64+
65+
-- | Add the @system@ module under the given name to the table of
66+
-- preloaded packages.
67+
preloadModule :: String -> Lua ()
68+
preloadModule name = Module.preloadModule $
69+
documentedModule { moduleName = T.pack name }
70+
71+
72+
--
73+
-- Functions
74+
--
75+
76+
functions :: [(Text, HaskellFunction)]
77+
functions =
78+
[ ("drop_extensions", drop_extensions)
79+
, ("has_extension", has_extension)
80+
, ("is_absolute", is_absolute)
81+
, ("is_relative", is_relative)
82+
, ("join_path", join_path)
83+
, ("normalise", normalise)
84+
, ("split_directories", split_directories)
85+
, ("take_directory", take_directory)
86+
, ("take_extensions", take_extensions)
87+
, ("take_filename", take_filename)
88+
]
89+
90+
peekFilePath :: Peeker FilePath
91+
peekFilePath = peekString
92+
93+
filepathParam :: Parameter FilePath
94+
filepathParam = Parameter
95+
{ parameterPeeker = peekFilePath
96+
, parameterDoc = ParameterDoc
97+
{ parameterName = "filepath"
98+
, parameterType = "string"
99+
, parameterDescription = "path"
100+
, parameterIsOptional = False
101+
}
102+
}
103+
104+
filepathResult :: Text -- ^ Description
105+
-> FunctionResult FilePath
106+
filepathResult desc = FunctionResult
107+
{ fnResultPusher = \fp -> 1 <$ pushString fp
108+
, fnResultDoc = Just $ FunctionResultDoc
109+
{ functionResultType = "string"
110+
, functionResultDescription = desc
111+
}
112+
}
113+
114+
filepathListResult :: Text -- ^ Description
115+
-> FunctionResult [FilePath]
116+
filepathListResult desc = FunctionResult
117+
{ fnResultPusher = \fp -> 1 <$ pushList pushString fp
118+
, fnResultDoc = Just $ FunctionResultDoc
119+
{ functionResultType = "list of strings"
120+
, functionResultDescription = desc
121+
}
122+
}
123+
124+
booleanResult :: Text -- ^ Description
125+
-> FunctionResult Bool
126+
booleanResult desc = FunctionResult
127+
{ fnResultPusher = \b -> 1 <$ pushBool b
128+
, fnResultDoc = Just $ FunctionResultDoc
129+
{ functionResultType = "boolean"
130+
, functionResultDescription = desc
131+
}
132+
}
133+
134+
-- | See @System.FilePath.dropExtension@
135+
drop_extensions :: HaskellFunction
136+
drop_extensions = toHsFnPrecursor Path.dropExtension
137+
<#> filepathParam
138+
=#> filepathResult "The modified filepath without extension"
139+
140+
-- | See @System.FilePath.hasExtension@
141+
has_extension :: HaskellFunction
142+
has_extension = toHsFnPrecursor Path.hasExtension
143+
<#> filepathParam
144+
=#> booleanResult ("`true` iff `filepath` has an extension, " <>
145+
"`false` otherwise.")
146+
147+
-- | See @System.FilePath.isAbsolute@
148+
is_absolute :: HaskellFunction
149+
is_absolute = toHsFnPrecursor Path.isAbsolute
150+
<#> filepathParam
151+
=#> booleanResult ("`true` iff `filepath` is an absolute path, " <>
152+
"`false` otherwise.")
153+
154+
-- | See @System.FilePath.isRelative@
155+
is_relative :: HaskellFunction
156+
is_relative = toHsFnPrecursor Path.isRelative
157+
<#> filepathParam
158+
=#> booleanResult ("`true` iff `filepath` is a relative path, " <>
159+
"`false` otherwise.")
160+
161+
-- | See @System.FilePath.joinPath@
162+
join_path :: HaskellFunction
163+
join_path = toHsFnPrecursor Path.joinPath
164+
<#> Parameter
165+
{ parameterPeeker = peekList peekFilePath
166+
, parameterDoc = ParameterDoc
167+
{ parameterName = "filepaths"
168+
, parameterType = "list of strings"
169+
, parameterDescription = "path components"
170+
, parameterIsOptional = False
171+
}
172+
}
173+
=#> filepathResult "The joined path."
174+
175+
-- | See @System.FilePath.normalise@
176+
normalise :: HaskellFunction
177+
normalise = toHsFnPrecursor Path.normalise
178+
<#> filepathParam
179+
=#> filepathResult "The normalised path."
180+
181+
-- | See @System.FilePath.splitDirectories@
182+
split_directories :: HaskellFunction
183+
split_directories = toHsFnPrecursor Path.splitDirectories
184+
<#> filepathParam
185+
=#> filepathListResult "A list of all directory paths."
186+
187+
-- | See @System.FilePath.takeDirectory@
188+
take_directory :: HaskellFunction
189+
take_directory = toHsFnPrecursor Path.normalise
190+
<#> filepathParam
191+
=#> filepathResult "The filepath up to the last directory separator."
192+
193+
-- | See @System.FilePath.takeExtensions@
194+
take_extensions :: HaskellFunction
195+
take_extensions = toHsFnPrecursor Path.takeExtensions
196+
<#> filepathParam
197+
=#> filepathResult "String of all extensions."
198+
199+
-- | See @System.FilePath.takeFilename@
200+
take_filename :: HaskellFunction
201+
take_filename = toHsFnPrecursor Path.takeFileName
202+
<#> filepathParam
203+
=#> filepathResult "File name part of the input path."

‎src/HsluaModulePaths.hs‎

Lines changed: 0 additions & 15 deletions
This file was deleted.

0 commit comments

Comments
 (0)