dirfiles (empty) → 0.1.0.0
raw patch · 6 files changed
+418/−0 lines, 6 filesdep +aesondep +basedep +containerssetup-changed
Dependencies added: aeson, base, containers, safecopy, special-keys, text, time, unordered-containers
Files
- Data/Library.hs +215/−0
- Data/Library/IRI.hs +67/−0
- Data/Library/UUIRI.hs +80/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- dirfiles.cabal +24/−0
+ Data/Library.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE OverloadedStrings,TemplateHaskell #-}+module Data.Library +( Library+, ItemId+, LibraryItem(..)+, Error(..)+, move+, copy+, delete+, rename+, describe+, touch+, new+, unsafeGetItem+, getItem+-- , testItem+)++where+import Data.Text (Text)+import Data.IntSet (IntSet, insert, empty)+import qualified Data.IntSet as IS+import Data.Sequence (Seq, adjust, (|>))+import qualified Data.Sequence as Seq+import Data.Time.Clock (UTCTime)+import Data.Library.UUIRI (UUIRI)+import Data.Foldable (toList)+import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), object, (.=), (.:), Value(Object, Null))+import Data.Aeson.Types (Parser)+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import qualified Data.HashMap.Strict as HM+import Data.SafeCopy (deriveSafeCopy, base)++-- | A Library is just a rebranded Seq+type Library = Seq LibraryItem+++type ItemId = Int++move :: Library -> ItemId -> ItemId -> UTCTime -> Either Error Library +move lib origin destination t = if origin == 0 then Left MovingRoot else do+ d <- getItem destination lib -- destination+ i <- getItem origin lib -- item+ let parentId = itemParent i+ p <- getItem parentId lib -- parent+ ud <- addItemInDir i d t -- updated destination+ up <- rmItemFromDir i p t -- updated parent+ return $ Seq.update destination ud + $ Seq.update parentId up + $ Seq.adjust (\item -> item { itemDateModified = t }) origin lib++copy :: Library -> ItemId -> ItemId -> UTCTime -> Either Error Library+copy lib origin destination t = do+ d <- getItem destination lib -- destination+ i <- getItem origin lib -- item+ let newParentId = itemId d+ newItem = i { itemDateModified = t+ , itemId = Seq.length lib+ , itemParent = newParentId }+ ud <- addItemInDir newItem d t -- add the copy to the destination+ return $ Seq.update newParentId ud (lib |> newItem)++delete :: Library -> ItemId -> Library+delete lib target = Seq.update target Deleted lib++-- | Changes the name of an item+rename :: Library -> ItemId -> Text -> UTCTime -> Library+rename lib target name t = Seq.adjust (setName t name) target lib+ where+ setName t' n i = i { itemDateModified = t', itemName = n }++-- | Sets the description of an item +describe :: Library -> ItemId -> Text -> UTCTime -> Library+describe lib target description t = + Seq.adjust (setDescription t description) target lib+ where+ setDescription t' d i = i { itemDateModified = t'+ , itemDescription = Just d }++-- | Sets the modified date of an item to the one supplied in arg t+touch :: Library -> ItemId -> UTCTime -> Library+touch lib target t = Seq.adjust (setTime t) target lib+ where+ setTime t i = i { itemDateModified = t }++-- | Create a new item in the library +-- If createing a directory then uuiri must be Nothing+new :: Text -> Maybe Text -> UTCTime -> ItemId -> Maybe UUIRI -> Library + -> Either Error Library+new name description creationTime parent uuiri lib = do+ p <- getItem parent lib -- parent directory+ up <- addItemInDir i p creationTime -- updated parent+ return $ Seq.update parent up -- updates the library with it+ $ lib |> i -- adds the new item to the library+ where+ i = Item (Seq.length lib) name description creationTime creationTime + parent $ maybe (Left (empty, empty)) Right uuiri++-- | No bounds checking and doesn't filter deleted items+-- returns an exception error when the item is not found+unsafeGetItem :: ItemId -> Library -> LibraryItem+unsafeGetItem = flip Seq.index ++-- | Does bounds checking and also checks if the item was not deleted+getItem :: ItemId -> Library -> Either Error LibraryItem+getItem i l = if i >= Seq.length l + then Left $ ItemNotFound i+ else let item = Seq.index l i + in case item of + Deleted -> Left $ ItemNotFound i+ _ -> Right item+--- // ---+-- HELPERS+itemOpInDir :: (Int -> IntSet -> IntSet) -> LibraryItem -> LibraryItem + -> UTCTime -> Either Error LibraryItem+itemOpInDir op item dir t = + case itemType dir of+ Right _ -> Left $ InvalidDestination (itemId dir)+ Left (files, dirs) -> Right $ + if isDir item + then dir { itemDateModified = t+ , itemType = Left (files, op (itemId item) dirs) + }+ else dir { itemDateModified = t+ , itemType = Left (op (itemId item) files, dirs) + }++addItemInDir :: LibraryItem -> LibraryItem -> UTCTime + -> Either Error LibraryItem+addItemInDir = itemOpInDir insert ++rmItemFromDir :: LibraryItem -> LibraryItem -> UTCTime + -> Either Error LibraryItem+rmItemFromDir = itemOpInDir IS.delete+-- HELPERS+--- // ---++-- | An item in the library+data LibraryItem = + Deleted | + Item + { itemId :: ItemId -- root dir is 0+ , itemName :: Text+ , itemDescription :: Maybe Text -- short description+ , itemDateCreated :: UTCTime+ , itemDateModified :: UTCTime+ , itemParent :: ItemId -- root dir has parent = 0+ , itemType :: Either Directory UUIRI+ } +++-- testItem t = Item 0 "teste" (Just "isto é um teste") t t 0 (Left (empty,empty))++instance ToJSON LibraryItem where+ toJSON Deleted = Null+ toJSON (Item iid iname idesc icreated imodified iparent itype) = + object ["id" .= iid, "name" .= iname, "description" .= idesc+ , "created" .= icreated, "modified" .= imodified+ , "parent" .= iparent, "item" .= typeJson+ ] + where + typeJson = case itype of+ Left (f,d) -> object [ "files" .= f + , "subdirectories" .= d+ ]+ Right f -> toJSON f++instance FromJSON LibraryItem where+ parseJSON Null = return Deleted+ parseJSON (Object i) = Item <$> i .: "id" + <*> i .: "name"+ <*> i .: "description"+ <*> i .: "created"+ <*> i .: "modified"+ <*> i .: "parent"+ <*> lookForItem i+ where + -- WARNING: HM.lookup might change if aeson changes the type + lookForItem i = maybe emptyDir getType $ HM.lookup "item" i + getType t = case t of + Object o -> toDirectory <$> o .: "files"+ <*> o .: "subdirectories"+ _ -> Right <$> parseJSON t+ toDirectory :: IntSet -> IntSet -> Either Directory UUIRI+ toDirectory f d = Left (f,d)+ emptyDir = return $ Left (empty, empty)+ parseJSON _ = mzero++isDir :: LibraryItem -> Bool+isDir i = case itemType i of + Right _ -> True+ _ -> False++-- | A directory is just a tuple of IntSet's where the first one has the+-- files, and the second has the subdirectories +type Directory = (IntSet, IntSet) +++-- | Some errors that might occur+data Error = InvalidDestination ItemId+ | ItemNotFound ItemId+ | MovingRoot+instance Show Error where+ show (InvalidDestination i) = "Invalid destination with id " ++ (show i)+ show (ItemNotFound i) = "Item with id " ++ (show i) ++ " not found"+ show MovingRoot = "Cannot move root directory"+{-+newFileTextIO :: Text -> Text -> IO FileText+newFileTextIO n c = do+ t <- getCurrentTime+ return $ newFileText n t c+-}++deriveSafeCopy 0 'base ''LibraryItem
+ Data/Library/IRI.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Data.Library.IRI+( IRI(Relative, Absolute)+, toIRI+, fromIRI+, isRelative+, isAbsolute+, extension+, domain+, protocol+, dirs+)+where++import Data.Text (Text, breakOn, split, splitOn)+import qualified Data.Text as T +import Data.Maybe+import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), Value(String))+import Control.Monad (mzero)+import Control.Applicative ((<$>))+import Data.SafeCopy (deriveSafeCopy, base)++data IRI = Relative Text+ | Absolute Text+ deriving(Show)+deriveSafeCopy 0 'base ''IRI -- from Data.SafeCopy++instance ToJSON IRI where+ toJSON = toJSON . fromIRI+instance FromJSON IRI where+ parseJSON (String s) = toIRI <$> return s+ parseJSON _ = mzero++toIRI :: Text -> IRI+toIRI t = if isTxtRelative then Relative t+ else Absolute t+ where isTxtRelative = T.null . snd $ breakOn "://" t++fromIRI :: IRI -> Text+fromIRI (Relative t) = t+fromIRI (Absolute t) = t++isRelative :: IRI -> Bool+isRelative (Relative _) = True+isRelative _ = False++isAbsolute :: IRI -> Bool+isAbsolute (Absolute _) = True+isAbsolute _ = False++extension :: IRI -> Maybe Text+extension = isDir . listToMaybe . reverse . split (== '.') . fromIRI+ where+ isDir = maybe Nothing (\t -> if T.last t == '/' then Nothing else Just t)++domain :: IRI -> Maybe Text+domain (Relative _) = Nothing+domain (Absolute t) = listToMaybe . drop 2 . splitOn "/" $ t++protocol :: IRI -> Maybe Text+protocol (Relative _) = Nothing+protocol (Absolute t) = listToMaybe $ splitOn "://" $ t++dirs :: IRI -> [Text]+dirs (Relative t) = split (== '/') t+dirs (Absolute t) = drop 3 $ split (== '/') t+
+ Data/Library/UUIRI.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Data.Library.UUIRI+( UUIRI (..)+, iri+, uuid+, toUUIRI+, fromUUIRI+, isRelative+, isAbsolute+, extension+, domain+, protocol+, dirs+)+where++import Data.Text (Text, breakOn, split, splitOn)+import qualified Data.Text as T +import Data.Maybe+import Data.Library.IRI (IRI, fromIRI)+import qualified Data.Library.IRI as IRI+import Keys.UUID (UUID)+import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), object, (.=), (.:), Value(Object))+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.SafeCopy (deriveSafeCopy, base)++newtype UUIRI = UUIRI (UUID, IRI) +deriveSafeCopy 0 'base ''UUIRI -- from Data.SafeCopy++instance Eq UUIRI where+ uuiri1 == uuiri2 = uuid uuiri1 == uuid uuiri2++instance ToJSON UUIRI where+ toJSON (UUIRI (u,i)) = object [ "uuid" .= u, "iri" .= fromIRI i ]++instance FromJSON UUIRI where+ parseJSON (Object v) = toUUIRI <$> v .: "uuid" <*> v .: "iri"+ parseJSON _ = mzero++-- | returns the IRI part of the UUIRI+iri :: UUIRI -> IRI+iri (UUIRI tuple) = snd tuple++-- | returns the UUID part of the UUIRI+uuid :: UUIRI -> UUID+uuid (UUIRI tuple) = fst tuple++-- | a constructor for UUIRIs+toUUIRI :: UUID -> Text -> UUIRI+toUUIRI u t = UUIRI (u, IRI.toIRI t)++-- | returns the UUIRI tuple with the IRI translated to Text+fromUUIRI :: UUIRI -> (UUID, Text)+fromUUIRI (UUIRI (u,iri)) = (u, IRI.fromIRI iri)++-- | is the IRI part of the UUIRI a relative IRI ?+isRelative :: UUIRI -> Bool+isRelative = IRI.isRelative . iri++-- | is the IRI part of the UUIRI an absolute IRI ?+isAbsolute :: UUIRI -> Bool+isAbsolute = IRI.isAbsolute . iri++-- | returns the IRI extension of a given UUIRI +extension :: UUIRI -> Maybe Text+extension = IRI.extension . iri++-- | returns the IRI domain of a given UUIRI +domain :: UUIRI -> Maybe Text+domain = IRI.domain . iri++-- | returns the IRI protocol of a given UUIRI +protocol :: UUIRI -> Maybe Text+protocol = IRI.protocol . iri++-- | returns the IRI directories of a given UUIRI +dirs :: UUIRI -> [Text]+dirs = IRI.dirs . iri+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, HugoDaniel++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 HugoDaniel 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
+ dirfiles.cabal view
@@ -0,0 +1,24 @@+-- Initial dirfiles.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: dirfiles+version: 0.1.0.0+-- synopsis: +description: Simple datatype to represent a library with files and folders+license: BSD3+license-file: LICENSE+author: HugoDaniel+maintainer: mr.hugo.gomes@gmail.com+-- copyright: +category: Data+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Data.Library, Data.Library.UUIRI, Data.Library.IRI+ -- other-modules: + other-extensions: OverloadedStrings, TemplateHaskell+ build-depends: base >=4.6 && <4.7, text >=0.11 && <0.12, containers >=0.5 && <0.6, time >=1.4 && <1.5, aeson >=0.6 && <0.7, unordered-containers >=0.2 && <0.3, safecopy >=0.8 && <0.9, special-keys >=0.1 && <0.2+ -- hs-source-dirs: + default-language: Haskell2010