data-filepath (empty) → 1.0.0.0
raw patch · 4 files changed
+250/−0 lines, 4 filesdep +basedep +ghc-primdep +splitsetup-changed
Dependencies added: base, ghc-prim, split, template-haskell
Files
- Data/FilePath.hs +199/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- data-filepath.cabal +19/−0
+ Data/FilePath.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE CPP, GADTs, DataKinds, KindSignatures, StandaloneDeriving, RankNTypes, DeriveDataTypeable, FlexibleInstances, MagicHash #-}+module Data.FilePath (Path, From, FilePath(..), rootPath, relativePath, (</>), mkDirPath, mkFilePath, mkFullFilePath, showp, dirpathQ, filepathQ) where++import Prelude hiding (FilePath)+import Data.Data+import Data.Char+import Data.List.Split+import Data.Maybe (fromJust)+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import GHC.Types++data Path = File | Directory+data From = Root | Relative+data FilePath (a :: From) (b :: Path) where+ RootPath :: FilePath Root Directory+ RelativePath :: FilePath Relative Directory+ FilePath :: FilePath a Directory -> String -> FilePath a File+ DirectoryPath :: FilePath a Directory -> String -> FilePath a Directory+++-- Path API+rootPath :: FilePath Root Directory+rootPath = RootPath++relativePath :: FilePath Relative Directory+relativePath = RelativePath++infixr 5 </>+(</>) :: FilePath a Directory -> FilePath Relative b -> FilePath a b+p </> RelativePath = p+p </> (DirectoryPath u s) = DirectoryPath (p </> u) s+p </> (FilePath u s) = FilePath (p </> u) s++mkDirPath :: String -> Maybe (FilePath Relative Directory)+mkDirPath s = DirectoryPath RelativePath `fmap` (mkf s)++mkFilePath :: String -> Maybe (FilePath Relative File)+mkFilePath s = FilePath RelativePath `fmap` (mkf s)++mkFullFilePath :: String -> Maybe (FilePath Root File)+mkFullFilePath ('/':s) = do+ y <- x+ ys <- xs+ return $ foldl (</>) (RootPath) ys </> y+ where+ ss = splitOn "/" s+ xs = sequence $ map mkDirPath $ init ss+ x = mkFilePath $ last ss+mkFullFilePath _ = Nothing -- all full file paths must start from /++showp :: FilePath a b -> String+showp RootPath = ""+showp RelativePath = "."+showp (DirectoryPath u s) = showp u ++ "/" ++ s+showp (FilePath u s) = showp u ++ "/" ++ s++mkf :: String -> Maybe String+mkf "" = Nothing -- an empty string is an invalid file/dir name+mkf s = if any (\x -> x == '/' || isControl x) s+ then Nothing+ else Just s++-- TODO: could it split the delimiters?+dirpathQ :: QuasiQuoter+dirpathQ = QuasiQuoter qExp qPat (error "dir paths are not types") (error "dir paths are not decs")+ where+ qExp :: String -> ExpQ+ qExp s = dataToExpQ (const Nothing) (DirectoryPath RelativePath (fromJust (mkf s)) :: FilePath Relative Directory)+ qPat = undefined++filepathQ :: QuasiQuoter+filepathQ = QuasiQuoter qExp qPat (error "file paths are not types") (error "file paths are not decs")+ where+ qExp :: String -> ExpQ+ qExp s = dataToExpQ (const Nothing) (FilePath RelativePath (fromJust (mkf s)) :: FilePath Relative File)+ qPat = undefined++-- data / typeable+-- deriving instance Show (FilePath a b)+instance Show (FilePath a b) where+ show = showp++instance Data+ (FilePath+ Relative Directory) where+ gfoldl _k_aFi z_aFj RelativePath+ = z_aFj RelativePath+ gfoldl+ k_aFo+ z_aFp+ (DirectoryPath a1_aFq a2_aFr)+ = ((z_aFp DirectoryPath `k_aFo` a1_aFq)+ `k_aFo` a2_aFr)+ gunfold k_aFs z_aFt c_aFu+ = case constrIndex c_aFu of+ GHC.Types.I# 2# -> z_aFt RelativePath+ GHC.Types.I# 4# -> k_aFs (k_aFs (z_aFt DirectoryPath))+ _ -> error "impossible"+ toConstr RelativePath+ = (cRelativePath)+ toConstr (DirectoryPath _ _)+ = (cDirectoryPath)+ dataTypeOf _ = (tFilePath)++instance Data+ (FilePath+ Root Directory) where+ gfoldl _k_aFv z_aFw RootPath+ = z_aFw RootPath+ gfoldl+ k_aFD+ z_aFE+ (DirectoryPath a1_aFF a2_aFG)+ = ((z_aFE DirectoryPath `k_aFD` a1_aFF)+ `k_aFD` a2_aFG)+ gunfold k_aFH z_aFI c_aFJ+ = case constrIndex c_aFJ of+ GHC.Types.I# 1# -> z_aFI RootPath+ GHC.Types.I# 4# -> k_aFH (k_aFH (z_aFI DirectoryPath))+ _ -> error "impossible"+ toConstr RootPath+ = (cRootPath)+ toConstr (DirectoryPath _ _)+ = (cDirectoryPath)+ dataTypeOf _ = (tFilePath)++instance Data+ (FilePath+ Relative File) where+ gfoldl k_aFO z_aFP (FilePath a1_aFQ a2_aFR)+ = ((z_aFP FilePath `k_aFO` a1_aFQ) `k_aFO` a2_aFR)+ gunfold k_aFW z_aFX c_aFY+ = case constrIndex c_aFY of+ GHC.Types.I# 3# -> k_aFW (k_aFW (z_aFX FilePath))+ _ -> error "impossible"+ toConstr (FilePath _ _)+ = (cFilePath)+ dataTypeOf _ = (tFilePath)++instance Data+ (FilePath Root File) where+ gfoldl k_aG3 z_aG4 (FilePath a1_aG5 a2_aG6)+ = ((z_aG4 FilePath `k_aG3` a1_aG5) `k_aG3` a2_aG6)+ gunfold k_aGb z_aGc c_aGd+ = case constrIndex c_aGd of+ GHC.Types.I# 3# -> k_aGb (k_aGb (z_aGc FilePath))+ _ -> error "impossible"+ toConstr (FilePath _ _)+ = (cFilePath)+ dataTypeOf _ = (tFilePath)++tFilePath :: DataType+cRootPath :: Constr+cRelativePath :: Constr+cFilePath :: Constr+cDirectoryPath :: Constr+tFilePath+ = mkDataType+ "FilePath"+ [(cRootPath), (cRelativePath),+ (cFilePath), (cDirectoryPath)]+cRootPath+ = mkConstr+ (tFilePath) "RootPath" [] Prefix+cRelativePath+ = mkConstr+ (tFilePath) "RelativePath" [] Prefix+cFilePath+ = mkConstr+ (tFilePath) "FilePath" [] Prefix+cDirectoryPath+ = mkConstr+ (tFilePath) "DirectoryPath" [] Prefix++#if (__GLASGOW_HASKELL__==706)+{-# NOINLINE fTyCon #-}+fTyCon :: TyCon+fTyCon = mkTyCon3 "main" "Data.FilePath" "FilePath"++instance Typeable (FilePath Relative Directory) where+ typeOf _ = mkTyConApp fTyCon []++instance Typeable (FilePath Root Directory) where+ typeOf _ = mkTyConApp fTyCon []++instance Typeable (FilePath Relative File) where+ typeOf _ = mkTyConApp fTyCon []++instance Typeable (FilePath Root File) where+ typeOf _ = mkTyConApp fTyCon []+#endif+#if (__GLASGOW_HASKELL__==708)+deriving instance Typeable Directory+deriving instance Typeable Relative+deriving instance Typeable Root+deriving instance Typeable File+deriving instance Typeable FilePath+#endif
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Maxwell Swadling++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Maxwell Swadling nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data-filepath.cabal view
@@ -0,0 +1,19 @@+name: data-filepath+version: 1.0.0.0+synopsis: A type safe file path data structure+-- description: +license: BSD3+license-file: LICENSE+author: Maxwell Swadling+maintainer: maxwellswadling@gmail.com+-- copyright: +category: Data+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Data.FilePath+ other-extensions: CPP, GADTs, DataKinds, KindSignatures, StandaloneDeriving, RankNTypes, DeriveDataTypeable, FlexibleInstances, MagicHash+ build-depends: base >=4.6 && <4.8, split >=0.2 && <0.3, template-haskell, ghc-prim+ default-language: Haskell2010