monopati 0.1.2 → 0.1.3

raw patch · 3 files changed

+116/−19 lines, 3 filesdep +hedgehogdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hedgehog, transformers

API changes (from Hackage documentation)

Files

• System/Monopati/Posix/Combinators.hs +74/−18
• Test/Monopati.hs +20/−0
• monopati.cabal +22/−1

@@ -1,15 +1,15 @@ module System.Monopati.Posix.Combinators 	( Points (..), Origin (..), To, Path, Outline (..)-	, Absolute (..), Homeward (..), Relative (..)-	, deeper, part, parent, (<^>), (</>), (<~/>)) where+	, Absolute, Currently, Homeward, Relative, Incompleted+	, deeper, part, parent, (<^>), (<.^>), (<~^>), (<^^>), (</>), (</.>), (</~>), (</^>)) where  import "base" Control.Applicative (pure)-import "base" Data.Eq (Eq ((==)))+import "base" Data.Eq (Eq ((/=))) import "base" Data.Foldable (Foldable (foldr)) import "base" Data.Function ((.), ($), (&), flip) import "base" Data.Functor ((<$>))-import "base" Data.Kind (Type)-import "base" Data.List (filter, init)+import "base" Data.Kind (Constraint, Type)+import "base" Data.List (filter, init, reverse) import "base" Data.Maybe (Maybe (Just, Nothing), maybe) import "base" Data.Semigroup (Semigroup ((<>))) import "base" Data.String (String)@@ -24,6 +24,7 @@ -- | What is the beginning of the path? data Origin 	= Root -- ^ (@/@) Starting point for absolute path+	| Current -- ^ (@~/@) Relatively current working directory 	| Home -- ^ (@~/@) Indication of home directory 	| Vague -- ^ Uncertain relative path @@ -34,7 +35,8 @@ type Path = Cofree Maybe String  -- | The internal type of path representation-newtype Outline (origin :: Origin) (points :: Points) = Outline { outline :: Path }+newtype Outline (origin :: Origin) (points :: Points) =+	Outline { outline :: Path } deriving Eq  instance Show (Outline Root Directory) where 	show = flip (<>) "/" . foldr (\x acc -> acc <> "/" <> x) "" . outline@@ -42,6 +44,12 @@ instance Show (Outline Root File) where 	show = foldr (\x acc -> acc <> "/" <> x) "" . outline +instance Show (Outline Current Directory) where+	show = (<>) "./" . foldr (\x acc -> x <> "/" <> acc) "" . outline++instance Show (Outline Current File) where+	show = (<>) "./" . init . foldr (\x acc -> x <> "/" <> acc) "" . outline+ instance Show (Outline Home Directory) where 	show = (<>) "~/" . foldr (\x acc -> x <> "/" <> acc) "" . outline @@ -57,12 +65,24 @@ instance Read (Outline Root Directory) where 	readsPrec _ ('/':[]) = [] 	readsPrec _ ('/':rest) = foldr (\el -> Just . (:<) el) Nothing-		(endBy "/" rest) & maybe [] (pure . (,[]) . Outline)+		(reverse $ endBy "/" rest) & maybe [] (pure . (,[]) . Outline) 	readsPrec _ _ = []  instance Read (Outline Root File) where 	readsPrec _ ('/':[]) = [] 	readsPrec _ ('/':rest) = foldr (\el -> Just . (:<) el) Nothing+		(reverse $ splitOn "/" rest) & maybe [] (pure . (,[]) . Outline)+	readsPrec _ _ = []++instance Read (Outline Current Directory) where+	readsPrec _ ('.':'/':[]) = []+	readsPrec _ ('.':'/':rest) = foldr (\el -> Just . (:<) el) Nothing+		(endBy "/" rest) & maybe [] (pure . (,[]) . Outline)+	readsPrec _ _ = []++instance Read (Outline Current File) where+	readsPrec _ ('.':'/':[]) = []+	readsPrec _ ('.':'/':rest) = foldr (\el -> Just . (:<) el) Nothing 		(splitOn "/" rest) & maybe [] (pure . (,[]) . Outline) 	readsPrec _ _ = [] @@ -91,36 +111,72 @@ type family Absolute (path :: Type) (to :: Type) (points :: Points) :: Type where 	Absolute Path To points = Outline Root points +type family Currently (path :: Type) (to :: Type) (points :: Points) :: Type where+	Currently Path To points = Outline Current points+ type family Homeward (path :: Type) (to :: Type) (points :: Points) :: Type where 	Homeward Path To points = Outline Home points  type family Relative (path :: Type) (to :: Type) (points :: Points) :: Type where 	Relative Path To points = Outline Vague points +type family Incompleted (outline :: Origin) :: Constraint where+	Incompleted Current = ()+	Incompleted Home = ()+	Incompleted Vague = ()+ -- | Immerse string into a path, filter slashes part :: String -> Outline origin points-part x = Outline $ (filter (== '/') x) :< Nothing+part x = Outline $ (filter (/= '/') x) :< Nothing +-- | Add relative path to uncompleted path+(<^>) :: forall origin points . Incompleted origin =>+	Outline origin Directory -> Relative Path To points -> Outline origin points+Outline (x :< Nothing) <^> Outline that = Outline $ x :< Just that+Outline (x :< Just this) <^> Outline that = (<^>) (part @origin x)+	$ (<^>) @Vague (Outline this) (Outline that)+ {-| @-"usr//local///" + "etc///" = "usr///local///etc//"+".//etc///" + "usr///local///" + = ".///etc///usr///local//" @ -}-(<^>) :: Relative Path To Directory -> Relative Path To points -> Relative Path To points-Outline (x :< Nothing) <^> Outline that = Outline $ x :< Just that-Outline (x :< Just this) <^> Outline that = part x <^> (Outline this <^> Outline that)+(<.^>) :: Currently Path To Directory -> Relative Path To points -> Currently Path To points+currently <.^> relative = currently <^> relative  {-| @-"//usr///bin///" + "git" = "///usr///bin//git"+"~//etc///" + "usr///local///" + = "~///etc///usr///local//" @ -}-(</>) :: Absolute Path To Directory -> Relative Path To points -> Absolute Path To points+(<~^>) :: Homeward Path To Directory -> Relative Path To points -> Homeward Path To points+homeward <~^> relative = homeward <^> relative++{-| @+"etc//" + "usr///local///" + = "etc///usr///local//"+@ -}+(<^^>) :: Relative Path To Directory -> Relative Path To points -> Relative Path To points+relative' <^^> relative = relative' <^> relative++-- | Absolutize uncompleted path+(</>) :: forall origin points . Incompleted origin =>+	Absolute Path To Directory-> Outline origin points -> Absolute Path To points Outline absolute </> Outline (x :< Nothing) = Outline . (:<) x . Just $ absolute-Outline absolute </> Outline (x :< Just xs) = (Outline . (:<) x . Just $ absolute) </> Outline xs+Outline absolute </> Outline (x :< Just xs) = (</>) @origin (Outline . (:<) x . Just $ absolute) $ Outline xs  {-| @+"//usr///local///" + ".///etc///" = "///usr///local///etc//"+@ -}+(</.>) :: Absolute Path To Directory -> Currently Path To points -> Absolute Path To points+absolute </.> currently = absolute </> currently++{-| @ "//usr///local///" + "~///etc///" = "///usr///local///etc//" @ -}-(<~/>) :: Absolute Path To points -> Homeward Path To points -> Absolute Path To points-Outline absolute <~/> Outline (x :< Nothing) = Outline . (:<) x . Just $ absolute-Outline absolute <~/> Outline (x :< Just xs) = (Outline . (:<) x . Just $ absolute) <~/> Outline xs+(</~>) :: Absolute Path To Directory -> Homeward Path To points -> Absolute Path To points+absolute </~> homeward = absolute </> homeward++{-| @+"//usr///bin///" + "git" = "///usr///bin//git"+@ -}+(</^>) :: Absolute Path To Directory -> Relative Path To points -> Absolute Path To points+absolute </^> relative = absolute </> relative  -- | Take parent directory of current pointed entity parent :: Absolute Path To points -> Maybe (Absolute Path To Directory)

@@ -0,0 +1,20 @@+module Main where++import "base" Data.Function (($))+import "base" System.IO (BufferMode(..), hSetBuffering, stdout, stderr)+import "hedgehog" Hedgehog (Group (..), checkParallel)++import Test.Monopati.Posix+	( show_then_read_absolute+	, show_then_read_currently+	, show_then_read_homeward+	, show_then_read_relative )++main = do+	hSetBuffering stdout LineBuffering+	hSetBuffering stderr LineBuffering+	checkParallel $ Group "Simple Posix tests" [+		("Show then read absolute", show_then_read_absolute),+		("Show then read currently", show_then_read_currently),+		("Show then read homeward", show_then_read_homeward),+		("Show then read relative", show_then_read_relative)]

@@ -1,5 +1,5 @@ name:                monopati-version:             0.1.2+version:             0.1.3 synopsis:            Well-typed paths description:         Despite the fact that there are a plenty of various well-typed "path" libraries in Haskell, I decided to write new one that I would like to use. homepage:            https://github.com/iokasimov/monopati@@ -24,6 +24,8 @@     KindSignatures     NoImplicitPrelude     PackageImports+    RankNTypes+    ScopedTypeVariables     TupleSections     TypeApplications     TypeFamilies@@ -36,4 +38,23 @@     System.Monopati.Posix.Combinators     System.Monopati.Windows.Calls     System.Monopati.Windows.Combinators+  ghc-options: -fno-warn-tabs++test-suite test+  type: exitcode-stdio-1.0+  main-is: Test/Monopati.hs+  build-depends: base == 4.*, directory, free, split, transformers, hedgehog+  default-extensions:+    OverloadedStrings+    DataKinds+    FlexibleInstances+    KindSignatures+    NoImplicitPrelude+    PackageImports+    RankNTypes+    ScopedTypeVariables+    TupleSections+    TypeApplications+    TypeFamilies+  default-language: Haskell2010   ghc-options: -fno-warn-tabs