{-# LANGUAGE TypeSynonymInstances, TemplateHaskell, QuasiQuotes, MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, ScopedTypeVariables #-} module Examples.CVS where import Language.Pads.Padsc import Language.Forest.Forestc hiding (Local, Dir, entries) import Language.Pads.GenPretty import System.IO.Unsafe (unsafePerformIO) [pads| data Repository_f = Repository_f (Line StringLn) data Mode_t = Ext ":ext:" | Local ":local:" | Server ":server:" data Root_t = Root_t { cvs_mode :: Maybe Mode_t , machine :: StringC ':', ':' , path :: StringLn } data Root_f = Root_f (Line Root_t) data Dentry_t = Dentry_t { "D/" , dirname :: StringC '/' , "////" } data Revision_t = Version (Int, '.', Int) | Added '0' | Removed '-' data TimeStamp_t = TimeStamp_t { ts :: StringSE '[/+]' , conflict :: Maybe ('+', StringC '/') } data Fentry_t = Fentry_t { "/" , filename :: StringC '/', "/" , revision :: Revision_t, "/" , timestamp :: TimeStamp_t, "/" , options :: StringC '/', "/" , tagdate :: StringLn } data Entry_t = Dir Dentry_t | File Fentry_t | NoDir 'D' data Entries_f = Entries_f ([Line Entry_t] terminator EOF) |] getEntries cvs = let (Entries_f l) = entries cvs in l isDir entry = case entry of {Dir _ -> True; otherwise -> False} isFile entry = case entry of {File _ -> True; otherwise -> False} getDirs cvs = map (\(Dir d) -> dirname d) (filter isDir (getEntries cvs)) getFiles cvs = map (\(File f) -> filename f) (filter isFile (getEntries cvs)) [forest| type CVS_d = Directory { repository is "Repository" :: File Repository_f , root is "Root" :: File Root_f , entries is "Entries" :: File Entries_f } type CVS_Repository_d = Directory { cvs is "CVS" :: CVS_d , dirs is [ d :: CVS_Repository_d | d <- <| getDirs cvs |> ] , files is [ f :: TextFile | f <- <| getFiles cvs |> ] } |] entries_file = meta_dir ++ "/Entries" (entries_rep, entries_pd) = let (Entries_f rep, md) = unsafePerformIO $ parseFile entries_file in (rep,md) meta_dir = "/Users/kfisher/pads/dirpads/src/Examples/CVS" (meta_rep, meta_md) = unsafePerformIO $ cVS_d_load meta_dir examples_dir = "/Users/kfisher/pads/dirpads/src/Examples" (examples_rep, examples_md) = unsafePerformIO $ cVS_Repository_d_load examples_dir babylon_dir = "/Users/kfisher/pads/dirpads/src/Examples/data/Simple/babylon" (babylon_rep, babylon_md) = unsafePerformIO $ cVS_Repository_d_load babylon_dir simple_dir = "/Users/kfisher/pads/dirpads/src/Examples/data/Simple" (simple_rep, simple_md) = unsafePerformIO $ cVS_Repository_d_load simple_dir classof10_dir = "/Users/kfisher/pads/dirpads/src/Examples/data/facadm/classof10" (classof10_rep, classof10_md) = unsafePerformIO $ cVS_Repository_d_load classof10_dir classof11_dir = "/Users/kfisher/pads/dirpads/src/Examples/data/facadm/classof11" (classof11_rep, classof11_md) = unsafePerformIO $ cVS_Repository_d_load classof11_dir facadm_dir = "/Users/kfisher/pads/dirpads/src/Examples/data/facadm" (facadm_rep, facadm_md) = unsafePerformIO $ cVS_Repository_d_load facadm_dir mkPrettyInstance ''CVS_Repository_d mkPrettyInstance ''CVS_Repository_d_md