aip 0.1.0 → 0.1.1

raw patch · 19 files changed

+1046/−238 lines, 19 filesdep +processdep +semigroupoidsdep +semigroupsdep ~QuickCheckdep ~basedep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: process, semigroupoids, semigroups

Dependency ranges changed: QuickCheck, base, directory, lens, tasty, tasty-hunit, tasty-quickcheck, time

API changes (from Hackage documentation)

Files

• aip.cabal +26/−19
• changelog.md +4/−0
• src-exe/Main.hs +2/−2
• src/Data/Aviation/Aip.hs +5/−1
• src/Data/Aviation/Aip/AfterDownload.hs +0/−72
• src/Data/Aviation/Aip/AipCon.hs +6/−0
• src/Data/Aviation/Aip/AipContents.hs +122/−0
• src/Data/Aviation/Aip/AipOptions.hs +6/−20
• src/Data/Aviation/Aip/AipRecord.hs +19/−12
• src/Data/Aviation/Aip/AipRecords.hs +16/−71
• src/Data/Aviation/Aip/Cache.hs +0/−1
• src/Data/Aviation/Aip/Href.hs +39/−0
• src/Data/Aviation/Aip/HttpRequest.hs +16/−25
• src/Data/Aviation/Aip/Log.hs +6/−5
• src/Data/Aviation/Aip/OnAipRecords.hs +202/−0
• src/Data/Aviation/Aip/PerHref.hs +162/−0
• src/Data/Aviation/Aip/Processing.hs +312/−0
• src/Data/Aviation/Aip/RunAipRecords.hs +78/−0
• src/Data/Aviation/Aip/SHA1.hs +25/−10

@@ -1,5 +1,5 @@ name:               aip-version:            0.1.0+version:            0.1.1 license:            BSD3 license-file:       LICENCE author:             Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>@@ -29,23 +29,26 @@                     base >= 4.8 && < 5                     , aeson >= 1.4.0.0 && < 1.5                     , aeson-pretty >= 0.8 && < 0.9-                    , unordered-containers >= 0.2.9.0 && < 0.3+                    , bytestring >= 0.10 && < 0.11+                    , Crypto >= 4.2.5.1 && < 4.3+                    , directory >= 1.3.1 && < 1.4+                    , exceptions >= 0.10.0 && < 1+                    , filepath >= 1.4 && < 1.5                     , HTTP >= 4000 && < 5000+                    , lens >= 4 && < 5+                    , optparse-applicative >= 0.13.2  && < 0.15+                    , parsec >= 3.1 && < 3.2+                    , parsers >= 0.12 && < 0.13                     , network-uri >= 2.6 && < 3+                    , process >= 1.6 && < 1.7+                    , semigroups >= 0.9 && < 0.19+                    , semigroupoids >= 5.2 && < 6                     , tagsoup >= 0.13 && < 0.15                     , tagsoup-selection >= 0.1 && < 0.2                     , transformers >= 0.5 && < 0.6-                    , parsers >= 0.12 && < 0.13-                    , parsec >= 3.1 && < 3.2-                    , bytestring >= 0.10 && < 0.11-                    , filepath >= 1.4 && < 1.5-                    , directory >= 1.3 && < 1.4-                    , lens >= 4 && < 5-                    , time >= 1.6 && < 1.9+                    , time >= 1.6 && < 1.10                     , utf8-string >= 1.0.1.1 && < 1.1-                    , Crypto >= 4.2.5.1 && < 4.3-                    , exceptions >= 0.10.0 && < 1-                    , optparse-applicative >= 0.13.2  && < 0.15+                    , unordered-containers >= 0.2.9.0 && < 0.3                        ghc-options:                     -Wall@@ -59,10 +62,10 @@    exposed-modules:                     Data.Aviation.Aip-                    Data.Aviation.Aip.AfterDownload                     Data.Aviation.Aip.Aip_SUP_and_AIC                     Data.Aviation.Aip.Aip_SUP_and_AICs                     Data.Aviation.Aip.AipCon+                    Data.Aviation.Aip.AipContents                     Data.Aviation.Aip.AipDate                     Data.Aviation.Aip.AipDocument                     Data.Aviation.Aip.AipDocuments@@ -87,6 +90,10 @@                     Data.Aviation.Aip.ListItemLinks                     Data.Aviation.Aip.ListItemLinks1                     Data.Aviation.Aip.Log+                    Data.Aviation.Aip.OnAipRecords+                    Data.Aviation.Aip.PerHref+                    Data.Aviation.Aip.Processing+                    Data.Aviation.Aip.RunAipRecords                     Data.Aviation.Aip.SHA1                     Data.Aviation.Aip.Title                     Data.Aviation.Aip.Txt@@ -102,7 +109,7 @@   build-depends:                     base >= 4.8 && < 5                     , aip-                    +   ghc-options:                     -Wall @@ -114,14 +121,14 @@  test-suite          tests -  build-depends:      QuickCheck >=2.9.2 && <2.11+  build-depends:      QuickCheck >=2.9.2 && <2.13                     , base >=4.8 && < 5                     , checkers >=0.4.6 && <0.5                     , aip-                    , lens >=4.15 && <4.16-                    , tasty >=0.11 && <0.12-                    , tasty-hunit >=0.9 && <0.10-                    , tasty-quickcheck >=0.8.4 && <0.10+                    , lens >=4 && <4.18+                    , tasty >=0.11 && <1.2+                    , tasty-hunit >=0.9 && <0.11+                    , tasty-quickcheck >=0.8.4 && <0.11    type:                                  exitcode-stdio-1.0

@@ -1,3 +1,7 @@+0.1.1++* Add post-processing after downloading AIP.+ 0.1.0  * Complete rewrite that fetches each document explicitly using HTML parsing.

@@ -4,10 +4,10 @@   main ) where -import Data.Aviation.Aip(run, nothingAfterDownload)+import Data.Aviation.Aip import System.IO(IO)  main ::   IO () main =-  run nothingAfterDownload+  run defaultPerHref defaultOnAipRecords

@@ -2,10 +2,10 @@   module A ) where -import Data.Aviation.Aip.AfterDownload as A import Data.Aviation.Aip.Aip_SUP_and_AIC as A import Data.Aviation.Aip.Aip_SUP_and_AICs as A import Data.Aviation.Aip.AipCon as A+import Data.Aviation.Aip.AipContents as A import Data.Aviation.Aip.AipDate as A import Data.Aviation.Aip.AipDocument as A import Data.Aviation.Aip.AipDocuments as A@@ -29,6 +29,10 @@ import Data.Aviation.Aip.ListItemLinks as A import Data.Aviation.Aip.ListItemLinks1 as A import Data.Aviation.Aip.Log as A+import Data.Aviation.Aip.OnAipRecords as A+import Data.Aviation.Aip.PerHref as A+import Data.Aviation.Aip.Processing as A+import Data.Aviation.Aip.RunAipRecords as A import Data.Aviation.Aip.SHA1 as A import Data.Aviation.Aip.Title as A import Data.Aviation.Aip.Txt as A

@@ -1,72 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}--module Data.Aviation.Aip.AfterDownload(-  AfterDownload(..)-, nothingAfterDownload-, filePathAfterDownload-, hrefAfterDownload-, AfterDownloadAipCon-) where--import Control.Category((.))-import Control.Applicative(Applicative(pure, (<*>)))-import Control.Lens-import Control.Monad(Monad(return, (>>=)))-import Data.Aviation.Aip.AipCon(AipCon)-import Data.Aviation.Aip.Href(Href)-import Data.Functor(Functor(fmap))-import System.FilePath(FilePath)--newtype AfterDownload f a =-  AfterDownload-    (FilePath -> Href -> f a)--instance Functor f => Functor (AfterDownload f) where-  fmap f (AfterDownload x) =-    AfterDownload (\p h -> fmap f (x p h))--instance Applicative f => Applicative (AfterDownload f) where-  pure =-    AfterDownload . pure . pure . pure-  AfterDownload f <*> AfterDownload a =-    AfterDownload (\p h -> f p h <*> a p h)--instance Monad f => Monad (AfterDownload f) where-  return =-    pure-  AfterDownload x >>= f =-    AfterDownload (\p h -> x p h >>= \a -> let g = f a ^. _Wrapped in g p h)--instance AfterDownload f a ~ x =>-  Rewrapped (AfterDownload g k) x--instance Wrapped (AfterDownload f k) where-  type Unwrapped (AfterDownload f k) =-      FilePath-      -> Href-      -> f k-  _Wrapped' =-    iso-      (\(AfterDownload x) -> x)-      AfterDownload--nothingAfterDownload ::-  Applicative f => AfterDownload f ()-nothingAfterDownload =-  pure ()--filePathAfterDownload ::-  Applicative f => AfterDownload f FilePath-filePathAfterDownload =-  AfterDownload (\p _ -> pure p)-  -hrefAfterDownload ::-  Applicative f => AfterDownload f Href-hrefAfterDownload =-  AfterDownload (\_ h -> pure h)--type AfterDownloadAipCon a =-  AfterDownload AipCon a

@@ -5,6 +5,7 @@  module Data.Aviation.Aip.AipCon(   AipCon(..)+, islog ) where  import Control.Category((.))@@ -61,3 +62,8 @@ instance MonadCatch AipCon where   catch (AipCon x) k =     AipCon (\b -> catch (x b) (\z -> let r = k z ^. _Wrapped in r b))++islog ::+  AipCon Bool+islog =+  AipCon pure

@@ -0,0 +1,122 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DefaultSignatures #-}++module Data.Aviation.Aip.AipContents(+  AipContents(..)+, AsAipContents(..)+, FoldAipContents(..)+, GetAipContents(..)+, SetAipContents(..)+, ManyAipContents(..)+, HasAipContents(..)+, IsAipContents(..)      +) where++import Control.Category((.), id)+import Control.Lens+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Ord(Ord)+import Data.String(String)+import Prelude(Show)++data AipContents =+  AipContents+    String -- path+    String -- query+    String -- body+  deriving (Eq, Ord, Show)++class ManyAipContents a => AsAipContents a where+  _AipContents ::+    Prism' a AipContents+  default _AipContents ::+    IsAipContents a =>+    Prism' a AipContents+  _AipContents =+    _IsAipContents+    +instance AsAipContents AipContents where+  _AipContents =+    id++class FoldAipContents a where+  _FoldAipContents ::+    Fold a AipContents+    +instance FoldAipContents AipContents where+  _FoldAipContents =+    id++class FoldAipContents a => GetAipContents a where+  _GetAipContents ::+    Getter a AipContents+  default _GetAipContents ::+    HasAipContents a =>+    Getter a AipContents+  _GetAipContents =+    aipContents+    +instance GetAipContents AipContents where+  _GetAipContents =+    id++class SetAipContents a where+  _SetAipContents ::+    Setter' a AipContents+  default _SetAipContents ::+    ManyAipContents a =>+    Setter' a AipContents+  _SetAipContents =+    _ManyAipContents++instance SetAipContents AipContents where+  _SetAipContents =+    id++class (FoldAipContents a, SetAipContents a) => ManyAipContents a where+  _ManyAipContents ::+    Traversal' a AipContents++instance ManyAipContents AipContents where+  _ManyAipContents =+    id++class (GetAipContents a, ManyAipContents a) => HasAipContents a where+  aipContents ::+    Lens' a AipContents+  default aipContents ::+    IsAipContents a =>+    Lens' a AipContents+  aipContents =+    _IsAipContents+  aipContentsPath ::+    Lens' a String+  aipContentsPath =+    aipContents . aipContentsPath+  aipContentsQuery ::+    Lens' a String+  aipContentsQuery =+    aipContents . aipContentsQuery+  aipContentsBody ::+    Lens' a String+  aipContentsBody =+    aipContents . aipContentsBody++instance HasAipContents AipContents where+  aipContents =+    id+  aipContentsPath f (AipContents p q b) =+    (\p' -> AipContents p' q b) <$> f p+  aipContentsQuery f (AipContents p q b) =+    (\q' -> AipContents p q' b) <$> f q+  aipContentsBody f (AipContents p q b) =+    (\b' -> AipContents p q b') <$> f b++class (HasAipContents a, AsAipContents a) => IsAipContents a where+  _IsAipContents ::+    Iso' a AipContents+    +instance IsAipContents AipContents where+  _IsAipContents =+    id

@@ -5,7 +5,6 @@ , aipOptionOutputDirectory , aipOptionCache , aipOptionLog-, aipOptionVerbose , parserAipOptions ) where @@ -27,28 +26,22 @@     FilePath     Cache     Bool -- log-    Bool -- verbose   deriving (Eq, Ord, Show)  aipOptionOutputDirectory ::   Lens' AipOptions FilePath-aipOptionOutputDirectory k (AipOptions d c l v) =-  fmap (\d' -> AipOptions d' c l v) (k d)+aipOptionOutputDirectory k (AipOptions d c l) =+  fmap (\d' -> AipOptions d' c l) (k d)  aipOptionCache ::   Lens' AipOptions Cache-aipOptionCache k (AipOptions d c l v) =-  fmap (\c' -> AipOptions d c' l v) (k c)+aipOptionCache k (AipOptions d c l) =+  fmap (\c' -> AipOptions d c' l) (k c)  aipOptionLog ::   Lens' AipOptions Bool-aipOptionLog k (AipOptions d c l v) =-  fmap (\l' -> AipOptions d c l' v) (k l)--aipOptionVerbose ::-  Lens' AipOptions Bool-aipOptionVerbose k (AipOptions d c l v) =-  fmap (\v' -> AipOptions d c l v') (k v)+aipOptionLog k (AipOptions d c l) =+  fmap (\l' -> AipOptions d c l') (k l)  parserAipOptions ::   Parser AipOptions@@ -84,11 +77,4 @@         long "log" <>         short 'l' <>         help "log to standard output"-      )-    <*>-    switch-      (-        long "verbose" <>-        short 'v' <>-        help "print the AIP document tree after download"       )

@@ -11,7 +11,6 @@ , ManyAipRecord(..) , HasAipRecord(..) , IsAipRecord(..)    -, aipRecordAipDocuments ) where  import Control.Category(id)@@ -19,7 +18,7 @@ import Control.Lens hiding ((.=)) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=)) import Data.Aviation.Aip.AipDocuments(AipDocuments2)-import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref)) import Data.Eq(Eq) import Data.Function(($)) import Data.Functor(fmap, (<$>))@@ -29,6 +28,7 @@ data AipRecord =   AipRecord     UTCTime+    Href     AipDocuments2   deriving (Eq, Show) @@ -37,11 +37,12 @@     withObject "AipRecord" $ \v ->       AipRecord <$>         v .: "utc" <*>+        v .: "index" <*>         v .: "documents"  instance ToJSON AipRecord where-  toJSON (AipRecord t p) =-    object ["utc" .= t, "documents" .= p]+  toJSON (AipRecord t i p) =+    object ["utc" .= t, "index" .= i, "documents" .= p]  class ManyAipRecord a => AsAipRecord a where   _AipRecord ::@@ -106,10 +107,22 @@     Lens' a AipRecord   aipRecord =     _IsAipRecord+  aipRecordTime ::+    Lens' a UTCTime+  aipRecordIndex ::+    Lens' a Href+  aipRecordAipDocuments ::+    Lens' a AipDocuments2  instance HasAipRecord AipRecord where   aipRecord =     id+  aipRecordTime k (AipRecord t i p) =+    fmap (\t' -> AipRecord t' i p) (k t)+  aipRecordIndex k (AipRecord t i p) =+    fmap (\i' -> AipRecord t i' p) (k i)+  aipRecordAipDocuments k (AipRecord t i p) =+    fmap (\p' -> AipRecord t i p') (k p)  class (HasAipRecord a, AsAipRecord a) => IsAipRecord a where   _IsAipRecord ::@@ -135,11 +148,5 @@     _ManyHref  instance ManyHref AipRecord where-  _ManyHref f (AipRecord t p) =-    AipRecord <$> pure t <*> _ManyHref f p--aipRecordAipDocuments ::-  Lens' AipRecord AipDocuments2-aipRecordAipDocuments k (AipRecord t p) =-  fmap (\p' -> AipRecord t p') (k p)-+  _ManyHref f (AipRecord t i p) =+    AipRecord <$> pure t <*> _ManyHref f i <*> _ManyHref f p

@@ -12,40 +12,32 @@ , HasAipRecords(..) , IsAipRecords(..)   , getAipRecords-, aipRecords1-, run ) where  import Control.Category((.), id)-import Control.Applicative(pure, (<*>), (<**>))+import Control.Applicative(pure, (<*>)) import Codec.Binary.UTF8.String as UTF8(encode)-import Control.Exception(IOException) import Control.Lens hiding ((.=))-import Control.Monad((>>=), when, unless)-import Control.Monad.Catch(MonadCatch(catch))+import Control.Monad((>>=), when) import Control.Monad.IO.Class(liftIO)-import Control.Monad.Trans.Except(runExceptT) import Data.Aeson(decodeFileStrict) import Data.Aeson.Encode.Pretty(confIndent, defConfig, Indent(Spaces), encodePretty') import qualified Data.ByteString.Lazy as LazyByteString(writeFile) import Data.Time(getCurrentTime) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=)) import Data.Aviation.Aip.AipDocument(AipDocument(Aip_Book, Aip_Charts, Aip_SUP_AIC, Aip_DAP, Aip_DAH, Aip_ERSA, Aip_AandB_Charts, Aip_Summary_SUP_AIC), runAipDocument)-import Data.Aviation.Aip.AfterDownload(AfterDownload(AfterDownload), AfterDownloadAipCon) import Data.Aviation.Aip.AipCon(AipCon)-import Data.Aviation.Aip.SHA1(showHash)+import Data.Aviation.Aip.AipContents(aipContentsBody, aipContentsPath, aipContentsQuery) import Data.Aviation.Aip.AipDate(AipDate(AipDate))-import Data.Aviation.Aip.AipOptions(parserAipOptions, aipOptionLog, aipOptionCache, aipOptionOutputDirectory, aipOptionVerbose) import Data.Aviation.Aip.AipDocuments(AipDocuments1, AipDocuments(AipDocuments)) import Data.Aviation.Aip.AipRecord(AipRecord(AipRecord), ManyAipRecord(_ManyAipRecord), FoldAipRecord, SetAipRecord, FoldAipRecord(_FoldAipRecord)) import Data.Aviation.Aip.Cache(Cache, isReadOrWriteCache, isWriteCache)-import Data.Aviation.Aip.Href(Href(Href), SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref), aipPrefix)-import Data.Aviation.Aip.HttpRequest(requestAipContents, downloadHref)-import Data.Aviation.Aip.Log(aiplog, aiplog')+import Data.Aviation.Aip.Href(Href(Href), SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref))+import Data.Aviation.Aip.HttpRequest(requestAipContents)+import Data.Aviation.Aip.Log(aiplog) import Data.Aviation.Aip.SHA1(SHA1, GetSHA1, ManySHA1(_ManySHA1), SetSHA1, HasSHA1(sha1), FoldSHA1(_FoldSHA1), hash, hashHex) import Data.Bool(Bool(True)) import Data.Char(isSpace)-import Data.Either(Either(Left, Right)) import Data.Eq(Eq((==))) import Data.Foldable(length, foldMap) import Data.Function(($))@@ -56,12 +48,9 @@ import Data.Monoid(Monoid(mempty)) import Data.Semigroup(Semigroup((<>))) import Data.String(String)-import Options.Applicative(execParser, info, helper, fullDesc, header) import Prelude(Show(show))-import System.Directory(doesDirectoryExist, doesFileExist, getPermissions, readable, createDirectoryIfMissing, removeDirectoryRecursive)-import System.Exit(exitWith, ExitCode(ExitFailure))+import System.Directory(doesFileExist, getPermissions, readable, createDirectoryIfMissing) import System.FilePath(takeDirectory, (</>), FilePath)-import System.IO(IO, putStrLn) import Text.HTML.TagSoup(Tag(TagText)) import Text.HTML.TagSoup.Tree(TagTree(TagBranch, TagLeaf), parseTree) import Text.HTML.TagSoup.Tree.Zipper(TagTreePos(TagTreePos), fromTagTree, traverseTree)@@ -146,10 +135,14 @@     Lens' a AipRecords   aipRecords =     _IsAipRecords+  aipRecords1 ::+    Lens' a (NonEmpty AipRecord)  instance HasAipRecords AipRecords where   aipRecords =     id+  aipRecords1 k (AipRecords s r) =+    fmap (\r' -> AipRecords s r') (k r)  class (HasAipRecords a, AsAipRecords a) => IsAipRecords a where   _IsAipRecords ::@@ -204,8 +197,8 @@               liftIO $ LazyByteString.writeFile z (encodePretty' conf rs)       trimSpaces =           dropWhile isSpace-  in  do  c <- requestAipContents          -          let h = hash (UTF8.encode c)+  in  do  c <- requestAipContents+          let h = hash (UTF8.encode (c ^. aipContentsBody))           let h' = hashHex h           aiplog ("aip contents, sha1: " <> h' "")           let z = dir </> h' ".json"@@ -245,11 +238,11 @@                     in  AipDocuments (x >>= li)                   traverseAipDocuments _ =                     mempty-              in  do  let AipDocuments a = foldMap (traverseTree traverseAipDocuments . fromTagTree) (parseTree c)+              in  do  let AipDocuments a = foldMap (traverseTree traverseAipDocuments . fromTagTree) (parseTree (c ^. aipContentsBody))                       q <- AipDocuments <$> traverse runAipDocument a                       t <- liftIO getCurrentTime-                      aiplog ("traverse aip records at time " <> show t)-                      let rs = AipRecords h (AipRecord t q :| [])+                      aiplog ("traverse aip records" <> show t)+                      let rs = AipRecords h (AipRecord t (Href (c ^. aipContentsPath <> c ^. aipContentsQuery)) q :| [])                       writeCache z rs                       pure rs @@ -289,51 +282,3 @@ instance HasSHA1 AipRecords where   sha1 k (AipRecords s r) =     fmap (\s' -> AipRecords s' r) (k s)--aipRecords1 ::-  Lens' AipRecords (NonEmpty AipRecord)-aipRecords1 k (AipRecords s r) =-  fmap (\r' -> AipRecords s r') (k r)---run ::-  AfterDownloadAipCon a-  -> IO ()-run k =-  let writeAip ::-        AfterDownloadAipCon a-        -> Cache-        -> FilePath-        -> AipCon AipRecords-      writeAip (AfterDownload w) cch dir =-        let catchIOException :: -              MonadCatch m =>-              m a ->-              (IOException -> m a)-              -> m a-            catchIOException =-              catch-        in  do  x <- getAipRecords cch dir-                let h = dir </> showHash x-                de <- liftIO $ doesDirectoryExist h-                let dl = mapMOf_ _ManyHref (\c -> downloadHref h c >>= \z -> w z c) (aipPrefix x)-                catchIOException (de `unless` dl) (\e ->-                  do  aiplog ("IO Exception: " <> show e)-                      liftIO $ removeDirectoryRecursive h)-                pure x-      p =-        execParser-          (info (parserAipOptions <**> helper) (-            fullDesc <>-            header "aip 0.1.0 <http://www.airservicesaustralia.com/aip/aip.asp>"-          )-        )-  in  do  opts <- p-          let lg = (opts ^. aipOptionLog)-          e <- runExceptT ((writeAip k (opts ^. aipOptionCache) (opts ^. aipOptionOutputDirectory) ^. _Wrapped) lg)-          case e of-            Left e' ->-              do  when lg (aiplog' ("network or HTTP error " <> show e'))-                  exitWith (ExitFailure 1)-            Right r ->-              when (opts ^. aipOptionVerbose) (putStrLn (show r))

@@ -193,4 +193,3 @@   -> Bool isWriteCache x =   not (isn't _ReadWriteCache x)-

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE CPP #-}  module Data.Aviation.Aip.Href(   Href(..)@@ -15,6 +16,7 @@ , IsHref(..) , dropHrefFile , aipPrefix+, windows_replace ) where  import Control.Category((.), id)@@ -24,6 +26,10 @@ import Data.Bool(bool) import Data.Char(Char) import Data.Eq(Eq((/=)))+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+import Data.Eq((==))+import Data.Foldable(elem, foldr)+#endif import Data.Functor((<$>)) import Data.Int(Int) import Data.List(reverse, dropWhile, isPrefixOf)@@ -220,3 +226,36 @@   -> s aipPrefix =   _ManyHref . _Wrapped %~ let p = "/aip/" in bool <$> (p <>) <*> id <*> isPrefixOf p++-- |+--+-- >>> windows_replace ""+-- ""+--+-- >>> windows_replace "abc"+-- "abc"+--+-- >>> windows_replace "abc/def"+-- "abc\\def"+--+-- >>> windows_replace "abc/def\\ghi"+-- "abc\\def_ghi"+--+-- >>> > windows_replace "abc\\def/ghi"+-- "abc_def\\ghi"+windows_replace ::+  String+  -> String+windows_replace x = +#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+  let +      win = [+              ((== '/'), '\\')+            , ((`elem` "\\:*\"?<>|"), '_')+            ]+      repl =+        (\ch -> foldr (\(p, ch') c -> bool c ch' (p c)) ch win)+  in  repl <$> x+#else+  x+#endif

@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE CPP #-}  module Data.Aviation.Aip.HttpRequest(   aipRequestGet@@ -21,17 +20,16 @@ import qualified Data.ByteString.Lazy as LazyByteString(writeFile) import Control.Monad.Trans.Except(ExceptT(ExceptT)) import Data.Aviation.Aip.AipCon(AipCon(AipCon))+import Data.Aviation.Aip.AipContents import Data.Aviation.Aip.Log(aiplog) import Data.Aviation.Aip.ConnErrorHttp4xx(ConnErrorHttp4xx(IsConnError, Http4xx))-import Data.Aviation.Aip.Href(Href(Href))+import Data.Aviation.Aip.Href(Href(Href), windows_replace)+import Data.Aviation.Aip.PerHref(PerHref(PerHref)) import Data.Bool(Bool(True), bool) import Data.Either(Either(Left, Right)) import Data.Eq(Eq((==)))-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-import Data.Foldable(elem)-import Data.Functor((<$>))-#endif import Data.Function(($))+import Data.Functor((<$>)) import Data.List(isPrefixOf, dropWhile) import Data.Maybe(Maybe(Just)) import Data.Semigroup(Semigroup((<>)))@@ -125,18 +123,19 @@   doRequest (aipRequestPost s z)  requestAipContents ::-  AipCon String+  AipCon AipContents requestAipContents =-  let r = setRequestBody-            (aipRequestPost (Href "aip.asp") "?pg=10")+  let path = "aip.asp"+      query = "?pg=10"+      r = setRequestBody+            (aipRequestPost (Href path) query)             ("application/x-www-form-urlencoded", "Submit=I+Agree&check=1")-  in  doRequest r+  in  AipContents path query <$> doRequest r  downloadHref ::-  FilePath-  -> Href-  -> AipCon FilePath-downloadHref d hf =+  PerHref AipCon FilePath+downloadHref =+  PerHref $ \hf _ d' _ ->   do  let q = aipRequestGet hf ""       aiplog ("making request for aip document " <> show q)       auth <- getAuth q@@ -144,19 +143,11 @@       c <- liftIO $ openStream (host auth) 80       r <- doRequest' (normalizeRequest defaultNormalizeRequestOptions q) c       let (j, k) = splitFileName (hf ^. _Wrapped)-      let ot = d </> dropWhile isPathSeparator j+      let ot = d' </> dropWhile isPathSeparator j       aiplog ("output directory for aip document " <> ot)       do  liftIO $ createDirectoryIfMissing True ot-          let ot' = ot </> k-          let otw =-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-                    let win = "/\\:*\"?<>|"-                        repl ch = bool ch '_' (ch `elem` win)-                    in  repl <$> ot'-#else-                    ot'-#endif                    +          let otw = ot </> windows_replace k           aiplog ("writing aip document " <> otw)           liftIO $ LazyByteString.writeFile otw r           liftIO $ close c-          pure ot'+          pure otw

@@ -5,17 +5,18 @@ , aiplog' ) where -import Control.Category((.))+import Control.Monad(when) import Control.Monad.IO.Class(MonadIO(liftIO))+import Data.Aviation.Aip.AipCon(AipCon, islog) import Data.String(String) import System.IO(hPutStrLn, stderr, IO)  aiplog ::-  MonadIO f =>   String-  -> f ()-aiplog =-  liftIO . aiplog'+  -> AipCon ()+aiplog s =+  do  b <- islog+      when b (liftIO (aiplog' s))  aiplog' ::   String

@@ -0,0 +1,202 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Aviation.Aip.OnAipRecords(+  OnAipRecords(..)+, ioOnAipRecords+, nothingOnAipRecords+, resultOnAipRecords+, logOnAipRecords+, downloaddirOnAipRecords+, basedirOnAipRecords+, aipRecordsOnAipRecords+, prefixedAipRecordsOnAipRecords+, aipRecordsTimeOnAipRecords+, aipRecordsTimesOnAipRecords+, printOnAipRecords+, OnAipRecordsAipCon+, OnAipRecordsIO+, logeachOnAipRecords+, logShowOnAipRecords+) where++import Control.Category((.))+import Control.Applicative(Applicative(pure, (<*>)), Alternative((<|>), empty))+import Control.Lens hiding ((<.>))+import Control.Monad(Monad(return, (>>=)))+import Control.Monad.IO.Class(MonadIO(liftIO))+import Control.Monad.Trans.Class(MonadTrans(lift))+import Data.Aviation.Aip.AipCon(AipCon)+import Data.Aviation.Aip.AipRecord(aipRecordTime)+import Data.Aviation.Aip.AipRecords(AipRecords, aipRecords1)+import Data.Aviation.Aip.Href(aipPrefix)+import Data.Either(Either(Left, Right), either)+import Data.Foldable(toList)+import Data.Functor(Functor(fmap))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Bind(Bind((>>-)))+import Data.List.NonEmpty(NonEmpty)+import Data.String(String)+import Data.Time(UTCTime)+import Prelude(Show(show))+import System.FilePath(FilePath)+import System.IO(IO, print, putStrLn)+import Control.Exception(IOException)++newtype OnAipRecords f a =+  OnAipRecords+    (Either IOException (FilePath, AipRecords) -> (String -> IO ()) -> FilePath -> f a)++instance Functor f => Functor (OnAipRecords f) where+  fmap f (OnAipRecords x) =+    OnAipRecords (\h l d -> fmap f (x h l d))++instance Apply f => Apply (OnAipRecords f) where+  OnAipRecords f <.> OnAipRecords a =+    OnAipRecords (\h l d -> f h l d <.> a h l d)++instance Applicative f => Applicative (OnAipRecords f) where+  pure =+    OnAipRecords . pure . pure . pure . pure++  OnAipRecords f <*> OnAipRecords a =+    OnAipRecords (\h l d -> f h l d <*> a h l d)++instance Bind f => Bind (OnAipRecords f) where+  OnAipRecords x >>- f =+    OnAipRecords (\h l d -> x h l d >>- \a -> let g = f a ^. _Wrapped in g h l d)++instance Monad f => Monad (OnAipRecords f) where+  return =+    pure+  OnAipRecords x >>= f =+    OnAipRecords (\h l d -> x h l d >>= \a -> let g = f a ^. _Wrapped in g h l d)++instance Alt f => Alt (OnAipRecords f) where+  OnAipRecords x <!> OnAipRecords y =+    OnAipRecords (\h l d -> x h l d <!> y h l d)++instance Alternative f => Alternative (OnAipRecords f) where+  OnAipRecords x <|> OnAipRecords y =+    OnAipRecords (\h l d -> x h l d <|> y h l d)+  empty =+    (OnAipRecords . pure . pure . pure) empty++instance MonadTrans OnAipRecords where+  lift =+    OnAipRecords . pure . pure . pure++instance MonadIO f => MonadIO (OnAipRecords f) where+  liftIO =+    OnAipRecords . pure . pure . pure . liftIO++instance OnAipRecords f a ~ x =>+  Rewrapped (OnAipRecords g k) x++instance Wrapped (OnAipRecords f k) where+  type Unwrapped (OnAipRecords f k) =+      Either IOException (FilePath, AipRecords)+      -> (String -> IO ())+      -> FilePath+      -> f k+  _Wrapped' =+    iso+      (\(OnAipRecords x) -> x)+      OnAipRecords++ioOnAipRecords ::+  MonadIO f =>+  (Either IOException (FilePath, AipRecords) -> (String -> IO ()) -> FilePath -> IO a)+  -> OnAipRecords f a+ioOnAipRecords k =+  OnAipRecords (\h l d -> liftIO (k h l d))++nothingOnAipRecords ::+  Applicative f =>+  OnAipRecords f ()+nothingOnAipRecords =+  pure ()++resultOnAipRecords ::+  Applicative f =>+  OnAipRecords f (Either IOException (FilePath, AipRecords))+resultOnAipRecords =+  OnAipRecords (\h _ _ -> pure h)++logOnAipRecords ::+  Applicative f =>+  OnAipRecords f (String -> IO ())+logOnAipRecords =+  OnAipRecords (\_ l _ -> pure l)++printOnAipRecords ::+  OnAipRecordsIO ()+printOnAipRecords =+  OnAipRecords (\h _ d ->+    do  case h of+          Left e ->+            print e+          Right (b, r) ->+            do  print r+                putStrLn b+        putStrLn d)++basedirOnAipRecords ::+  Applicative f =>+  OnAipRecords f FilePath+basedirOnAipRecords =+  OnAipRecords (\_ _ d -> pure d)++downloaddirOnAipRecords ::+  Applicative f =>+  OnAipRecords f (Either IOException FilePath)+downloaddirOnAipRecords =+  OnAipRecords (\e _ _ -> pure (fmap (view _1) e))++aipRecordsOnAipRecords ::+  Applicative f =>+  OnAipRecords f (Either IOException AipRecords)+aipRecordsOnAipRecords =+  OnAipRecords (\e _ _ -> pure (fmap (view _2) e))++prefixedAipRecordsOnAipRecords ::+  Applicative f =>+  OnAipRecords f (Either IOException AipRecords)+prefixedAipRecordsOnAipRecords =+  fmap (fmap aipPrefix) aipRecordsOnAipRecords++aipRecordsTimeOnAipRecords ::+  Applicative f =>+  OnAipRecords f (Either IOException (NonEmpty UTCTime))+aipRecordsTimeOnAipRecords =+  fmap (fmap (fmap (view aipRecordTime) . view aipRecords1)) aipRecordsOnAipRecords++aipRecordsTimesOnAipRecords ::+  Applicative f =>+  OnAipRecords f [UTCTime]+aipRecordsTimesOnAipRecords =+  fmap (either (pure []) toList) aipRecordsTimeOnAipRecords++type OnAipRecordsAipCon a =+  OnAipRecords AipCon a++type OnAipRecordsIO a =+  OnAipRecords IO a++logeachOnAipRecords ::+  OnAipRecordsIO ()+logeachOnAipRecords =+  OnAipRecords (\h l d ->+    do  l (either show show h)+        l (show d))++logShowOnAipRecords ::+  Show a =>+  a+  -> OnAipRecordsIO ()+logShowOnAipRecords z =+  do  l <- logOnAipRecords+      lift (l (show z))

@@ -0,0 +1,162 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Aviation.Aip.PerHref(+  PerHref(..)+, ioPerHref+, nothingPerHref+, hrefPerHref+, basedirPerHref+, downloaddirPerHref+, logPerHref+, logeachPerHref+, logShowPerHref+, PerHrefAipCon+, PerHrefIO+) where++import Control.Category((.))+import Control.Applicative(Applicative(pure, (<*>)), Alternative((<|>), empty))+import Control.Lens hiding ((<.>))+import Control.Monad(Monad(return, (>>=)))+import Control.Monad.IO.Class(MonadIO(liftIO))+import Control.Monad.Trans.Class(MonadTrans(lift))+import Data.Aviation.Aip.AipCon(AipCon)+import Data.Aviation.Aip.Href(Href)+import Data.Functor(Functor(fmap))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Bind(Bind((>>-)))+import Data.String(String)+import Prelude(Show(show))+import System.FilePath(FilePath)+import System.IO(IO)++newtype PerHref f a =+  PerHref+    (Href -> FilePath -> FilePath -> (String -> AipCon ()) -> f a)++instance Functor f => Functor (PerHref f) where+  fmap f (PerHref x) =+    PerHref (\h d d' l -> fmap f (x h d d' l))++instance Apply f => Apply (PerHref f) where+  PerHref f <.> PerHref a =+    PerHref (\h d d' l -> f h d d' l <.> a h d d' l)++instance Applicative f => Applicative (PerHref f) where+  pure =+    PerHref . pure . pure . pure . pure . pure++  PerHref f <*> PerHref a =+    PerHref (\h d d' l -> f h d d' l <*> a h d d' l)++instance Bind f => Bind (PerHref f) where+  PerHref x >>- f =+    PerHref (\h d d' l -> x h d d' l >>- \a -> let g = f a ^. _Wrapped in g h d d' l)++instance Monad f => Monad (PerHref f) where+  return =+    pure+  PerHref x >>= f =+    PerHref (\h d d' l -> x h d d' l >>= \a -> let g = f a ^. _Wrapped in g h d d' l)++instance Alt f => Alt (PerHref f) where+  PerHref x <!> PerHref y =+    PerHref (\h d d' l -> x h d d' l <!> y h d d' l)++instance Alternative f => Alternative (PerHref f) where+  PerHref x <|> PerHref y =+    PerHref (\h d d' l -> x h d d' l <|> y h d d' l)+  empty =+    (PerHref . pure . pure . pure . pure) empty++instance MonadTrans PerHref where+  lift =+    PerHref . pure . pure . pure . pure++instance MonadIO f => MonadIO (PerHref f) where+  liftIO =+    PerHref . pure . pure . pure . pure . liftIO++instance PerHref f a ~ x =>+  Rewrapped (PerHref g k) x++instance Wrapped (PerHref f k) where+  type Unwrapped (PerHref f k) =+      Href+      -> FilePath+      -> FilePath+      -> (String -> AipCon ())+      -> f k+  _Wrapped' =+    iso+      (\(PerHref x) -> x)+      PerHref++ioPerHref ::+  MonadIO f =>+  (Href -> FilePath -> FilePath -> (String -> AipCon ()) -> IO a)+  -> PerHref f a+ioPerHref k =+  PerHref (\h d d' l -> liftIO (k h d d' l))++nothingPerHref ::+  Applicative f =>+  PerHref f ()+nothingPerHref =+  pure ()++hrefPerHref ::+  Applicative f =>+  PerHref f Href+hrefPerHref =+  PerHref (\h _ _ _ -> pure h)++basedirPerHref ::+  Applicative f =>+  PerHref f FilePath+basedirPerHref =+  PerHref (\_ d _ _ -> pure d)++downloaddirPerHref ::+  Applicative f =>+  PerHref f FilePath+downloaddirPerHref =+  PerHref (\_ _ d' _ -> pure d')++logPerHref ::+  Applicative f =>+  PerHref f (String -> AipCon ())+logPerHref =+  PerHref (\_ _ _ l -> pure l)++type PerHrefAipCon a =+  PerHref AipCon a++type PerHrefIO a =+  PerHref IO a++logeachPerHref ::+  PerHrefAipCon ()+logeachPerHref =+  PerHref (\h d d' l ->+    let l' ::+          Show a =>+          a+          -> AipCon ()+        l' =+          l . show+    in  do  l' h+            l' d+            l' d')++logShowPerHref ::+  Show a =>+  a+  -> PerHrefAipCon ()+logShowPerHref z =+  do  l <- logPerHref+      lift (l (show z))

@@ -0,0 +1,312 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Aviation.Aip.Processing(+  defaultPerHref+, defaultOnAipRecords+, removeDate+, getSymbolicLinkTarget'+, latestLinkList+, latestLink+, followLinks+, archive+, timeLink+, doRelative+, removeIfExistsThenCreateDirectoryLink+, mkdir+, removeFileIfExists+, removeDateFilePath+) where++import Control.Applicative(liftA2, pure)+import Control.Category((.), id)+import Control.Exception(IOException, throwIO)+import Control.Lens+import Control.Monad((>>=), unless, join)+import Control.Monad.Catch(MonadCatch(catch))+import Control.Monad.IO.Class(liftIO)+import Data.Aviation.Aip.Href(Href(Href), _ManyHref, windows_replace)+import Data.Aviation.Aip.HttpRequest(downloadHref)+import Data.Aviation.Aip.OnAipRecords(OnAipRecordsIO, logShowOnAipRecords, logeachOnAipRecords, prefixedAipRecordsOnAipRecords, downloaddirOnAipRecords, basedirOnAipRecords, aipRecordsTimesOnAipRecords)+import Data.Aviation.Aip.PerHref(PerHrefAipCon, logShowPerHref, logeachPerHref)+import Data.Bool(Bool(True), bool)+import Data.Char(isDigit, isUpper)+import Data.Either(Either)+import Data.Foldable(toList, and, all)+import Data.Function(($))+import Data.Functor((<$), (<$>))+import Data.List(intercalate, dropWhile, reverse, drop)+import Data.Maybe(Maybe(Nothing, Just), maybe)+import Data.Ord((<))+import Data.Semigroup((<>))+import Data.String(String)+import Data.Time(UTCTime(UTCTime), toGregorian)+import Data.Traversable(mapM)+import Prelude(Integer, show, round, (*))+import System.Directory(createDirectoryLink, getSymbolicLinkTarget, doesFileExist, doesDirectoryExist, createDirectoryIfMissing, removeFile)+import System.Exit(ExitCode)+import System.FilePath(FilePath, splitDirectories, isPathSeparator, joinPath, (</>), takeDirectory, splitFileName, makeRelative, splitPath)+import System.IO(IO)+import System.IO.Error(isDoesNotExistError)+import System.Process(system)++defaultPerHref ::+  PerHrefAipCon ()+defaultPerHref =+  do  z <- downloadHref+      logShowPerHref z+      logeachPerHref++defaultOnAipRecords ::+  OnAipRecordsIO ()+defaultOnAipRecords =+  do  k <- latestLink+      t <- timeLink+      r <- removeDate+      c <- archive (latestLinkList k)+      logShowOnAipRecords k+      logShowOnAipRecords t+      logShowOnAipRecords r+      logShowOnAipRecords c+      logeachOnAipRecords++removeDate ::+  OnAipRecordsIO [FilePath]+removeDate =+  let linkHref ::+        Either IOException FilePath+        -> Href+        -> IO (Maybe FilePath)+      linkHref d (Href h) =+        let ms = +              do  d'     <- d ^? _Right+                  (a, r) <- unsnoc . splitDirectories . dropWhile isPathSeparator $ h+                  pure (d', a, r)+        in  mapM (\(d', a, j) ->+              do  let i = joinPath a+                  let i' = d' </> "nodate" </> i+                  let link = i' </> removeDateFilePath j+                  mkdir i'+                  _ <-  removeIfExistsThenCreateDirectoryLink+                          link+                          (".." </> joinPath (".." <$ a) </> d' </> i </> j)+                  pure link+                  ) ms+  in  do  r <- prefixedAipRecordsOnAipRecords+          d <- downloaddirOnAipRecords+          z <- liftIO $ traverse (linkHref d) (toListOf (_Right . _ManyHref) r)+          pure (z ^.. folded . _Just)++getSymbolicLinkTarget' ::+  FilePath+  -> IO (Maybe FilePath)+getSymbolicLinkTarget' x =+  let catchIOException :: +        MonadCatch m =>+        m a ->+        (IOException -> m a)+        -> m a+      catchIOException =+        catch+  in  catchIOException (Just <$> getSymbolicLinkTarget x) (pure (pure Nothing))++latestLinkList ::+  Either IOException (Maybe FilePath, FilePath, FilePath)+  -> [FilePath]+latestLinkList g =+  maybe [] pure (g ^? _Right . _2)+  +latestLink ::+  OnAipRecordsIO (Either IOException (Maybe FilePath, FilePath, FilePath))+latestLink =+  downloaddirOnAipRecords >>=+    mapM (\p -> let lt = takeDirectory p </> "latest"+                in  do  z <- liftIO (removeIfExistsThenCreateDirectoryLink lt p)+                        b <- basedirOnAipRecords+                        let bt = b </> "latest"+                        _ <- liftIO (removeIfExistsThenCreateDirectoryLink bt lt)+                        pure (z, bt, lt))++followLinks ::+  FilePath+  -> IO FilePath+followLinks p =+  do  r <- getSymbolicLinkTarget' p+      case r of+        Nothing ->+          pure p+        Just s ->+          followLinks s++archive ::+  [FilePath]+  -> OnAipRecordsIO (Either IOException [(FilePath, ExitCode)])+archive x =+  let system' ::+        [String]+        -> IO ExitCode+      system' s =+        do  let s' = intercalate " " s+            e <- system s'+            pure e+      quote ::+        String+        -> String+      quote w =+        '"' : w <> "\""+      targz ::+        Traversable f =>+        f FilePath+        -> OnAipRecordsIO [(FilePath, ExitCode)]+      targz d =+        liftIO $+          (^.. folded . _Just) <$>+          mapM (\d' ->+            do  d'' <- followLinks d'+                let (b', z') = splitFileName d''+                    (b, z) = splitFileName d'+                    arch = b </> z <> ".tar.gz"+                a <- doesFileExist arch+                if a+                  then+                    pure Nothing+                  else+                    do  t <- doesDirectoryExist d'+                        if t+                          then+                            do  k <- system'+                                      [+                                        "tar"+                                      , "--transform"+                                      , quote ("s/" <> z' <> "/" <> z <> "/")+                                      , "-C"+                                      , b'+                                      , "-czvf"+                                      , quote arch+                                      , z'+                                      ]+                                pure (Just (arch, k))+                          else+                            pure Nothing+          ) d+  in  do  d <- downloaddirOnAipRecords+          mapM (\d' -> targz (x <>+                                [+                                  d'+                                , d' </> "aip" </> "current"+                                , d' </> "aip" </> "current" </> "aip"+                                , d' </> "aip" </> "current" </> "aipchart"+                                , d' </> "aip" </> "current" </> "aipchart" </> "erch"+                                , d' </> "aip" </> "current" </> "aipchart" </> "ercl"+                                , d' </> "aip" </> "current" </> "aipchart" </> "pca"+                                , d' </> "aip" </> "current" </> "aipchart" </> "tac"+                                , d' </> "aip" </> "current" </> "aipchart" </> "vnc"+                                , d' </> "aip" </> "current" </> "aipchart" </> "vtc"+                                , d' </> "aip" </> "current" </> "dap"+                                , d' </> "aip" </> "current" </> "ersa"+                                , d' </> "aip" </> "current" </> "sup"+                                , d' </> "aip" </> "current" </> "SUP_AIP_Summary"+                                , d' </> "aip" </> "pending"+                                , d' </> "aip" </> "pending" </> "aip"+                                , d' </> "aip" </> "pending" </> "aipchart"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "erch"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "ercl"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "pca"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "tac"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "vnc"+                                , d' </> "aip" </> "pending" </> "aipchart" </> "vtc"+                                , d' </> "aip" </> "pending" </> "dap"+                                , d' </> "aip" </> "pending" </> "ersa"+                                , d' </> "aip" </> "pending" </> "sup"+                                , d' </> "aip" </> "pending" </> "SUP_AIP_Summary"+                                ])) d++timeLink ::+  OnAipRecordsIO [FilePath]+timeLink =+  let timeDirectory ::+        UTCTime+        -> FilePath+      timeDirectory (UTCTime dy f) =+        let (y, m, d) =+              toGregorian dy+            xx n =+              bool id ('0':) (n < 10) (show n)+        in  join+              [+                show y+              , "-"+              , xx m+              , "-"+              , xx d+              , "."+              , show (round (f * 1000) :: Integer)+              ]+  in  do  d <- basedirOnAipRecords+          p <- downloaddirOnAipRecords+          let td = d </> "time"+          liftIO $ mkdir td+          t <- aipRecordsTimesOnAipRecords+          let links =+                do  t' <- t+                    p' <- toList p+                    pure (td </> timeDirectory t', p')+          liftIO $+            mapM (\b ->+              let (u, v) = doRelative b d+              in  do  _ <- removeIfExistsThenCreateDirectoryLink u v+                      pure u) links+            +-- |+--+-- >>> doRelative ("/a/b/c/d/e", "/a/b/c") "/a/b"+-- ("/a/b/c/d/e","../../c")+--+-- >>> doRelative ("/a/b/c/d/e", "/a/b/c/x") "/a/b"+-- ("/a/b/c/d/e","../../c/x")+--+-- >>> doRelative ("/a/b/c/d/e", "/a/b/c/x") "/a"+-- ("/a/b/c/d/e","../../../b/c/x")+doRelative ::+  (FilePath, FilePath)+  -> FilePath+  -> (FilePath, FilePath)+doRelative x a =+  let (q, r) = (both %~ makeRelative a) x+      q' = joinPath . reverse . drop 1 . set (_tail . traverse) ".." . reverse . splitPath $ q+  in  (a </> q, q' </> r)++removeIfExistsThenCreateDirectoryLink ::+  FilePath+  -> FilePath+  -> IO (Maybe FilePath)+removeIfExistsThenCreateDirectoryLink u v =+  do  r <- getSymbolicLinkTarget' u+      removeFileIfExists u+      createDirectoryLink v u+      pure r++mkdir ::+  String+  -> IO ()+mkdir d =+  createDirectoryIfMissing True (windows_replace d) ++removeFileIfExists ::+  FilePath+  -> IO ()+removeFileIfExists fileName =+  removeFile fileName `catch` (liftA2 unless isDoesNotExistError throwIO)++removeDateFilePath ::+  FilePath+  -> FilePath+removeDateFilePath x =+  case reverse x of+    (ext3:ext2:ext1:'.':y4:y3:y2:y1:m3:m2:m1:d2:d1:'_':r) ->+      if and [all isDigit [y4,y3,y2,y1], all isUpper [m3,m2,m1], all isDigit [d2,d1]]+        then+          reverse r <> ('.':ext1:ext2:[ext3])+        else+          x+    _ ->+      x

@@ -0,0 +1,78 @@+module Data.Aviation.Aip.RunAipRecords(+  run+) where++import Control.Applicative(pure, (<**>))+import Control.Category((.))+import Control.Exception(IOException)+import Control.Lens+import Control.Monad(when, unless)+import Control.Monad.Catch(MonadCatch(catch))+import Control.Monad.IO.Class(liftIO)+import Control.Monad.Trans.Except(runExceptT)+import Data.Aviation.Aip.AipCon(AipCon)+import Data.Aviation.Aip.AipOptions(parserAipOptions, aipOptionLog, aipOptionCache, aipOptionOutputDirectory)+import Data.Aviation.Aip.AipRecords(AipRecords, getAipRecords)+import Data.Aviation.Aip.Cache(Cache)+import Data.Aviation.Aip.Href(ManyHref(_ManyHref), aipPrefix)+import Data.Aviation.Aip.Log(aiplog, aiplog')+import Data.Aviation.Aip.OnAipRecords(OnAipRecords(OnAipRecords), OnAipRecordsIO)+import Data.Aviation.Aip.PerHref(PerHref(PerHref), PerHrefAipCon)+import Data.Aviation.Aip.SHA1(_GetSHA1, strHash)+import Data.Either(Either(Left, Right))+import Data.Function(($))+import Data.Semigroup(Semigroup((<>)))+import Options.Applicative(execParser, info, helper, fullDesc, header)+import Prelude(show)+import System.Directory(doesDirectoryExist, removeDirectoryRecursive)+import System.Exit(exitWith, ExitCode(ExitFailure))+import System.FilePath(FilePath, (</>))+import System.IO(IO)++run ::+  PerHrefAipCon ()+  -> OnAipRecordsIO ()+  -> IO ()+run k (OnAipRecords l) =+  let writeAip ::+        PerHrefAipCon ()+        -> Cache+        -> FilePath+        -> AipCon (Either IOException (FilePath, AipRecords))+      writeAip (PerHref w) cch dir =+        let catchIOException :: +              MonadCatch m =>+              m a ->+              (IOException -> m a)+              -> m a+            catchIOException =+              catch+        in  do  let dir' = dir </> "sha1"+                x <- getAipRecords cch dir'+                let h = dir' </> view (_GetSHA1 . re strHash) x+                de <- liftIO $ doesDirectoryExist h+                let dl = mapMOf_ _ManyHref (\c -> w c dir h aiplog) (aipPrefix x)+                catchIOException+                  (do de `unless` dl+                      pure (Right (h, x)))+                  (\e ->+                          do  aiplog ("IO Exception: " <> show e)+                              liftIO $ removeDirectoryRecursive h+                              pure (Left e))+      p =+        execParser+          (info (parserAipOptions <**> helper) (+            fullDesc <>+            header "aip 0.1.1 <http://www.airservicesaustralia.com/aip/aip.asp>"+          )+        )+  in  do  opts <- p+          let lg = (opts ^. aipOptionLog)+          let dir = opts ^. aipOptionOutputDirectory+          e <- runExceptT ((writeAip k (opts ^. aipOptionCache) dir ^. _Wrapped) lg)+          case e of+            Left e' ->+              do  when lg (aiplog' ("network or HTTP error " <> show e'))+                  exitWith (ExitFailure 1)+            Right r ->+              l r aiplog' dir

@@ -13,7 +13,7 @@ , hash , hashHex , showsHash-, showHash+, strHash ) where  import Control.Category((.), id)@@ -24,10 +24,11 @@ import qualified Data.Digest.SHA1 as SHA1(hash, toInteger) import Data.Eq(Eq) import Data.Functor((<$>))+import Data.Maybe(Maybe(Nothing)) import Data.String(String)-import Data.Word(Word8)-import Numeric(showHex)-import Prelude(Show, ShowS)+import Data.Word(Word8, Word32)+import Numeric(showHex, readHex)+import Prelude(Show, ShowS, ReadS)  newtype SHA1 =   SHA1@@ -145,9 +146,23 @@ showsHash x =   hashHex (x ^. sha1) -showHash ::-  HasSHA1 s =>-  s-  -> String-showHash x =-  showsHash x ""+strHash ::+  Prism'+    String+    SHA1+strHash =+  prism'+    (\x -> showsHash x "")+    (\h ->  case h of+              (a0:a1:a2:a3:a4:a5:a6:a7:b0:b1:b2:b3:b4:b5:b6:b7:c0:c1:c2:c3:c4:c5:c6:c7:d0:d1:d2:d3:d4:d5:d6:d7:e0:e1:e2:e3:e4:e5:e6:e7:[]) ->+                let word32 w = +                      (readHex :: ReadS Word32) w ^? _head . _1+                in  do  w1 <- word32 [a0,a1,a2,a3,a4,a5,a6,a7]+                        w2 <- word32 [b0,b1,b2,b3,b4,b5,b6,b7]+                        w3 <- word32 [c0,c1,c2,c3,c4,c5,c6,c7]+                        w4 <- word32 [d0,d1,d2,d3,d4,d5,d6,d7]+                        w5 <- word32 [e0,e1,e2,e3,e4,e5,e6,e7]+                        pure (SHA1 (Word160 w1 w2 w3 w4 w5))+              _ ->+                Nothing)+