summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorqfpl <>2018-09-13 08:07:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-09-13 08:07:00 (GMT)
commit65b357f7f3dd10869f6153d00b609911d37535d2 (patch)
tree95e71bcc1404b23629a62fbbca2f5d0b4c571872
parent5429c2e6e5c7ba13440e10842f3228f742ab271a (diff)
version 0.1.00.1.0
-rw-r--r--LICENCE104
-rw-r--r--Setup.hs2
-rw-r--r--Setup.lhs44
-rw-r--r--aip.cabal112
-rw-r--r--changelog3
-rw-r--r--changelog.md11
-rw-r--r--src-exe/Main.hs13
-rw-r--r--src/Data/Aviation/Aip.hs32
-rw-r--r--src/Data/Aviation/Aip/AfterDownload.hs72
-rw-r--r--src/Data/Aviation/Aip/AipCon.hs63
-rw-r--r--src/Data/Aviation/Aip/AipDate.hs235
-rw-r--r--src/Data/Aviation/Aip/AipDocument.hs696
-rw-r--r--src/Data/Aviation/Aip/AipDocuments.hs1357
-rw-r--r--src/Data/Aviation/Aip/AipHref.hs89
-rw-r--r--src/Data/Aviation/Aip/AipOptions.hs94
-rw-r--r--src/Data/Aviation/Aip/AipPg.hs34
-rw-r--r--src/Data/Aviation/Aip/AipRecord.hs145
-rw-r--r--src/Data/Aviation/Aip/AipRecords.hs339
-rw-r--r--src/Data/Aviation/Aip/Aip_SUP_and_AIC.hs151
-rw-r--r--src/Data/Aviation/Aip/Aip_SUP_and_AICs.hs186
-rw-r--r--src/Data/Aviation/Aip/Amendment.hs201
-rw-r--r--src/Data/Aviation/Aip/Cache.hs196
-rw-r--r--src/Data/Aviation/Aip/ConnErrorHttp4xx.hs100
-rw-r--r--src/Data/Aviation/Aip/DAPDoc.hs154
-rw-r--r--src/Data/Aviation/Aip/DAPDocs.hs184
-rw-r--r--src/Data/Aviation/Aip/DAPEntries.hs185
-rw-r--r--src/Data/Aviation/Aip/DAPEntry.hs147
-rw-r--r--src/Data/Aviation/Aip/DAPType.hs137
-rw-r--r--src/Data/Aviation/Aip/Day.hs31
-rw-r--r--src/Data/Aviation/Aip/DocumentNumber.hs201
-rw-r--r--src/Data/Aviation/Aip/Ersa.hs156
-rw-r--r--src/Data/Aviation/Aip/ErsaAerodrome.hs142
-rw-r--r--src/Data/Aviation/Aip/ErsaAerodromes.hs186
-rw-r--r--src/Data/Aviation/Aip/Ersas.hs68
-rw-r--r--src/Data/Aviation/Aip/Href.hs222
-rw-r--r--src/Data/Aviation/Aip/HttpRequest.hs136
-rw-r--r--src/Data/Aviation/Aip/ListItemLink.hs143
-rw-r--r--src/Data/Aviation/Aip/ListItemLinks.hs197
-rw-r--r--src/Data/Aviation/Aip/ListItemLinks1.hs185
-rw-r--r--src/Data/Aviation/Aip/Log.hs24
-rw-r--r--src/Data/Aviation/Aip/Month.hs51
-rw-r--r--src/Data/Aviation/Aip/SHA1.hs153
-rw-r--r--src/Data/Aviation/Aip/Title.hs202
-rw-r--r--src/Data/Aviation/Aip/Txt.hs207
-rw-r--r--src/Data/Aviation/Aip/Year.hs36
-rw-r--r--src/Main.hs37
-rw-r--r--test/Tests.hs4
-rw-r--r--test/doctests.hs32
48 files changed, 5614 insertions, 1885 deletions
diff --git a/LICENCE b/LICENCE
index 1404e19..1698bd1 100644
--- a/LICENCE
+++ b/LICENCE
@@ -1,77 +1,31 @@
-CSIRO Open Source Software License Agreement (variation of the BSD / MIT
-License)
-
-Copyright (c) 2016, Commonwealth Scientific and Industrial Research Organisation
+Copyright 2017,2018 Commonwealth Scientific and Industrial Research Organisation
(CSIRO) ABN 41 687 119 230.
-All rights reserved. CSIRO is willing to grant you a license to this
-aemo-webservice on the following terms, except where otherwise indicated for
-third party material.
-
-Redistribution and use of this software 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 CSIRO nor the names of its contributors may be used to
- endorse or promote products derived from this software without specific prior
- written permission of CSIRO.
-
-EXCEPT AS EXPRESSLY STATED IN THIS AGREEMENT AND TO THE FULL EXTENT PERMITTED BY
-APPLICABLE LAW, THE SOFTWARE IS PROVIDED "AS-IS". CSIRO MAKES NO
-REPRESENTATIONS, WARRANTIES OR CONDITIONS OF ANY KIND, EXPRESS OR IMPLIED,
-INCLUDING BUT NOT LIMITED TO ANY REPRESENTATIONS, WARRANTIES OR CONDITIONS
-REGARDING THE CONTENTS OR ACCURACY OF THE SOFTWARE, OR OF TITLE,
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT, THE ABSENCE
-OF LATENT OR OTHER DEFECTS, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT
-DISCOVERABLE.
-
-TO THE FULL EXTENT PERMITTED BY APPLICABLE LAW, IN NO EVENT SHALL CSIRO BE
-LIABLE ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, IN AN ACTION FOR
-BREACH OF CONTRACT, NEGLIGENCE OR OTHERWISE) FOR ANY CLAIM, LOSS, DAMAGES OR
-OTHER LIABILITY HOWSOEVER INCURRED. WITHOUT LIMITING THE SCOPE OF THE PREVIOUS
-SENTENCE THE EXCLUSION OF LIABILITY SHALL INCLUDE: LOSS OF PRODUCTION OR
-OPERATION TIME, LOSS, DAMAGE OR CORRUPTION OF DATA OR RECORDS; OR LOSS OF
-ANTICIPATED SAVINGS, OPPORTUNITY, REVENUE, PROFIT OR GOODWILL, OR OTHER ECONOMIC
-LOSS; OR ANY SPECIAL, INCIDENTAL, INDIRECT, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY
-DAMAGES, ARISING OUT OF OR IN CONNECTION WITH THIS AGREEMENT, ACCESS OF THE
-SOFTWARE OR ANY OTHER DEALINGS WITH THE SOFTWARE, EVEN IF CSIRO HAS BEEN ADVISED
-OF THE POSSIBILITY OF SUCH CLAIM, LOSS, DAMAGES OR OTHER LIABILITY.
-
-APPLICABLE LEGISLATION SUCH AS THE AUSTRALIAN CONSUMER LAW MAY APPLY
-REPRESENTATIONS, WARRANTIES, OR CONDITIONS, OR IMPOSES OBLIGATIONS OR LIABILITY
-ON CSIRO THAT CANNOT BE EXCLUDED, RESTRICTED OR MODIFIED TO THE FULL EXTENT SET
-OUT IN THE EXPRESS TERMS OF THIS CLAUSE ABOVE "CONSUMER GUARANTEES". TO THE
-EXTENT THAT SUCH CONSUMER GUARANTEES CONTINUE TO APPLY, THEN TO THE FULL EXTENT
-PERMITTED BY THE APPLICABLE LEGISLATION, THE LIABILITY OF CSIRO UNDER THE
-RELEVANT CONSUMER GUARANTEE IS LIMITED (WHERE PERMITTED AT CSIRO'S OPTION) TO
-ONE OF FOLLOWING REMEDIES OR SUBSTANTIALLY EQUIVALENT REMEDIES:
-
-(a) THE REPLACEMENT OF THE SOFTWARE, THE SUPPLY OF EQUIVALENT
- SOFTWARE, OR SUPPLYING RELEVANT SERVICES AGAIN;
-(b) THE REPAIR OF THE SOFTWARE;
-(c) THE PAYMENT OF THE COST OF REPLACING THE
- SOFTWARE, OF ACQUIRING EQUIVALENT SOFTWARE, HAVING THE
- RELEVANT SERVICES SUPPLIED AGAIN, OR HAVING THE SOFTWARE
- REPAIRED.
-
-IN THIS CLAUSE, CSIRO INCLUDES ANY THIRD PARTY AUTHOR OR OWNER OF ANY PART OF
-THE SOFTWARE OR MATERIAL DISTRIBUTED WITH IT. CSIRO MAY ENFORCE ANY RIGHTS ON
-BEHALF OF THE RELEVANT THIRD PARTY.
-
-Third Party Components
-
-The following third party components are distributed with the Software. You
-agree to comply with the license terms for these components as part of accessing
-the Software. Other third party software may also be identified in separate
-files distributed with the Software.
-
-___________________________________________________________________
-
-___________________________________________________________________
+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 QFPL 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Setup.lhs b/Setup.lhs
deleted file mode 100644
index 0832aa5..0000000
--- a/Setup.lhs
+++ /dev/null
@@ -1,44 +0,0 @@
-#!/usr/bin/env runhaskell
-\begin{code}
-{-# OPTIONS_GHC -Wall #-}
-module Main (main) where
-
-import Data.List ( nub )
-import Data.Version ( showVersion )
-import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )
-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
-import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )
-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
-import Distribution.Verbosity ( Verbosity )
-import System.FilePath ( (</>) )
-
-main :: IO ()
-main = defaultMainWithHooks simpleUserHooks
- { buildHook = \pkg lbi hooks flags -> do
- generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
- buildHook simpleUserHooks pkg lbi hooks flags
- }
-
-generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-generateBuildModule verbosity pkg lbi = do
- let dir = autogenModulesDir lbi
- createDirectoryIfMissingVerbose verbosity True dir
- withLibLBI pkg lbi $ \_ libcfg -> do
- withTestLBI pkg lbi $ \suite suitecfg -> do
- rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
- [ "module Build_" ++ testName suite ++ " where"
- , "deps :: [String]"
- , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
- ]
- where
- formatdeps = map (formatone . snd)
- formatone p = case packageName p of
- PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
-
-testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
-
-\end{code}
diff --git a/aip.cabal b/aip.cabal
index 242ae9f..570f04d 100644
--- a/aip.cabal
+++ b/aip.cabal
@@ -1,35 +1,35 @@
name: aip
-version: 0.0.1
+version: 0.1.0
license: BSD3
license-file: LICENCE
author: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>
maintainer: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>
-copyright: Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.
+copyright: Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.
synopsis: Aeronautical Information Package (AIP)
category: Data, Aviation
description:
<<http://i.imgur.com/uZnp9ke.png>>
.
- Document managament for the airservices Aeronautical Information Package (AIP).
+ Document management for the airservices Aeronautical Information Package (AIP).
homepage: https://github.com/qfpl/aip
bug-reports: https://github.com/qfpl/aip/issues
cabal-version: >= 1.10
-build-type: Custom
-extra-source-files: changelog
+build-type: Simple
+extra-source-files: changelog.md
source-repository head
type: git
location: git@github.com:qfpl/aip.git
-flag small_base
- description: Choose the new, split-up base package.
-
library
default-language:
Haskell2010
build-depends:
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
, HTTP >= 4000 && < 5000
, network-uri >= 2.6 && < 3
, tagsoup >= 0.13 && < 0.15
@@ -37,12 +37,15 @@ library
, transformers >= 0.5 && < 0.6
, parsers >= 0.12 && < 0.13
, parsec >= 3.1 && < 3.2
- , digit >= 0.2 && < 0.3
, bytestring >= 0.10 && < 0.11
, filepath >= 1.4 && < 1.5
, directory >= 1.3 && < 1.4
, lens >= 4 && < 5
- , papa >= 0.3 && < 0.4
+ , time >= 1.6 && < 1.9
+ , 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
ghc-options:
-Wall
@@ -56,18 +59,38 @@ library
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.AipDate
Data.Aviation.Aip.AipDocument
Data.Aviation.Aip.AipDocuments
- Data.Aviation.Aip.AipHref
- Data.Aviation.Aip.AipPg
+ Data.Aviation.Aip.AipOptions
+ Data.Aviation.Aip.AipRecord
+ Data.Aviation.Aip.AipRecords
+ Data.Aviation.Aip.Amendment
+ Data.Aviation.Aip.Cache
Data.Aviation.Aip.ConnErrorHttp4xx
- Data.Aviation.Aip.Day
+ Data.Aviation.Aip.DAPDoc
+ Data.Aviation.Aip.DAPDocs
+ Data.Aviation.Aip.DAPEntries
+ Data.Aviation.Aip.DAPEntry
+ Data.Aviation.Aip.DAPType
+ Data.Aviation.Aip.DocumentNumber
Data.Aviation.Aip.Ersa
- Data.Aviation.Aip.Ersas
+ Data.Aviation.Aip.ErsaAerodrome
+ Data.Aviation.Aip.ErsaAerodromes
+ Data.Aviation.Aip.Href
Data.Aviation.Aip.HttpRequest
- Data.Aviation.Aip.Month
- Data.Aviation.Aip.Year
+ Data.Aviation.Aip.ListItemLink
+ Data.Aviation.Aip.ListItemLinks
+ Data.Aviation.Aip.ListItemLinks1
+ Data.Aviation.Aip.Log
+ Data.Aviation.Aip.SHA1
+ Data.Aviation.Aip.Title
+ Data.Aviation.Aip.Txt
+
executable aip
main-is:
@@ -78,20 +101,8 @@ executable aip
build-depends:
base >= 4.8 && < 5
- , HTTP >= 4000 && < 5000
- , network-uri >= 2.6 && < 3
- , 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
- , digit >= 0.2 && < 0.3
- , bytestring >= 0.10 && < 0.11
- , filepath >= 1.4 && < 1.5
- , directory >= 1.3 && < 1.4
- , lens >= 4 && < 5
- , papa >= 0.3 && < 0.4
-
+ , aip
+
ghc-options:
-Wall
@@ -99,31 +110,30 @@ executable aip
NoImplicitPrelude
hs-source-dirs:
- src
+ src-exe
+
+test-suite tests
+
+ build-depends: QuickCheck >=2.9.2 && <2.11
+ , 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
-test-suite doctests
- type:
+ type:
exitcode-stdio-1.0
- main-is:
- doctests.hs
+ main-is:
+ Tests.hs
- default-language:
- Haskell2010
+ hs-source-dirs:
+ test
- build-depends:
- base < 5 && >= 3
- , doctest >= 0.9.7
- , filepath >= 1.3
- , directory >= 1.1
- , QuickCheck >= 2.0
- , template-haskell >= 2.8
- , parsec >= 3.1
- , quickcheck-text
+ default-language:
+ Haskell2010
- ghc-options:
+ ghc-options:
-Wall
- -threaded
-
- hs-source-dirs:
- test
diff --git a/changelog b/changelog
deleted file mode 100644
index c42e25e..0000000
--- a/changelog
+++ /dev/null
@@ -1,3 +0,0 @@
-0.0.1
-
-* Initial release
diff --git a/changelog.md b/changelog.md
new file mode 100644
index 0000000..65e2be2
--- /dev/null
+++ b/changelog.md
@@ -0,0 +1,11 @@
+0.1.0
+
+* Complete rewrite that fetches each document explicitly using HTML parsing.
+
+0.0.2
+
+* Factor out `main` to `distributeAipDocuments`.
+
+0.0.1
+
+* Initial release
diff --git a/src-exe/Main.hs b/src-exe/Main.hs
new file mode 100644
index 0000000..5d46f08
--- /dev/null
+++ b/src-exe/Main.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Main(
+ main
+) where
+
+import Data.Aviation.Aip(run, nothingAfterDownload)
+import System.IO(IO)
+
+main ::
+ IO ()
+main =
+ run nothingAfterDownload
diff --git a/src/Data/Aviation/Aip.hs b/src/Data/Aviation/Aip.hs
index d167a2d..f90cb3b 100644
--- a/src/Data/Aviation/Aip.hs
+++ b/src/Data/Aviation/Aip.hs
@@ -2,15 +2,33 @@ module Data.Aviation.Aip(
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.AipDate as A
import Data.Aviation.Aip.AipDocument as A
import Data.Aviation.Aip.AipDocuments as A
-import Data.Aviation.Aip.AipHref as A
-import Data.Aviation.Aip.AipPg as A
+import Data.Aviation.Aip.AipOptions as A
+import Data.Aviation.Aip.AipRecord as A
+import Data.Aviation.Aip.AipRecords as A
+import Data.Aviation.Aip.Amendment as A
+import Data.Aviation.Aip.Cache as A
import Data.Aviation.Aip.ConnErrorHttp4xx as A
-import Data.Aviation.Aip.Day as A
-import Data.Aviation.Aip.Ersa as A
-import Data.Aviation.Aip.Ersas as A
+import Data.Aviation.Aip.DAPDoc as A
+import Data.Aviation.Aip.DAPDocs as A
+import Data.Aviation.Aip.DAPEntries as A
+import Data.Aviation.Aip.DAPEntry as A
+import Data.Aviation.Aip.DAPType as A
import Data.Aviation.Aip.HttpRequest as A
-import Data.Aviation.Aip.Month as A
-import Data.Aviation.Aip.Year as A
+import Data.Aviation.Aip.Ersa as A
+import Data.Aviation.Aip.ErsaAerodrome as A
+import Data.Aviation.Aip.ErsaAerodromes as A
+import Data.Aviation.Aip.Href as A
+import Data.Aviation.Aip.ListItemLink as A
+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.SHA1 as A
+import Data.Aviation.Aip.Title as A
+import Data.Aviation.Aip.Txt as A
diff --git a/src/Data/Aviation/Aip/AfterDownload.hs b/src/Data/Aviation/Aip/AfterDownload.hs
new file mode 100644
index 0000000..36aa53b
--- /dev/null
+++ b/src/Data/Aviation/Aip/AfterDownload.hs
@@ -0,0 +1,72 @@
+{-# 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
diff --git a/src/Data/Aviation/Aip/AipCon.hs b/src/Data/Aviation/Aip/AipCon.hs
new file mode 100644
index 0000000..2869f34
--- /dev/null
+++ b/src/Data/Aviation/Aip/AipCon.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Aviation.Aip.AipCon(
+ AipCon(..)
+) where
+
+import Control.Category((.))
+import Control.Applicative(Applicative(pure, (<*>)))
+import Control.Lens
+import Control.Monad(Monad(return, (>>=)))
+import Control.Monad.Catch(MonadThrow(throwM), MonadCatch(catch))
+import Control.Monad.IO.Class(MonadIO(liftIO))
+import Control.Monad.Trans.Except(ExceptT)
+import Data.Aviation.Aip.ConnErrorHttp4xx(ConnErrorHttp4xx)
+import Data.Bool(Bool)
+import Data.Functor(Functor(fmap))
+import System.IO(IO)
+
+newtype AipCon a =
+ AipCon (Bool -> ExceptT ConnErrorHttp4xx IO a)
+
+instance AipCon a ~ r =>
+ Rewrapped (AipCon b) r
+
+instance Wrapped (AipCon x) where
+ type Unwrapped (AipCon x) =
+ Bool
+ -> ExceptT ConnErrorHttp4xx IO x
+ _Wrapped' =
+ iso
+ (\(AipCon x) -> x)
+ AipCon
+
+instance Functor AipCon where
+ fmap f (AipCon x) =
+ AipCon (fmap (fmap f) x)
+
+instance Applicative AipCon where
+ pure =
+ AipCon . pure . pure
+ AipCon f <*> AipCon a =
+ AipCon (\b -> f b <*> a b)
+
+instance Monad AipCon where
+ return =
+ pure
+ AipCon x >>= f =
+ AipCon (\b -> x b >>= \a -> let r = f a ^. _Wrapped in r b)
+
+instance MonadIO AipCon where
+ liftIO =
+ AipCon . pure . liftIO
+
+instance MonadThrow AipCon where
+ throwM e =
+ AipCon (\_ -> throwM e)
+
+instance MonadCatch AipCon where
+ catch (AipCon x) k =
+ AipCon (\b -> catch (x b) (\z -> let r = k z ^. _Wrapped in r b))
diff --git a/src/Data/Aviation/Aip/AipDate.hs b/src/Data/Aviation/Aip/AipDate.hs
index 2420b50..d98b02d 100644
--- a/src/Data/Aviation/Aip/AipDate.hs
+++ b/src/Data/Aviation/Aip/AipDate.hs
@@ -1,65 +1,192 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
module Data.Aviation.Aip.AipDate(
AipDate(..)
-, parseAipDate
-, uriAipDate
+, AsAipDate(..)
+, FoldAipDate(..)
+, GetAipDate(..)
+, SetAipDate(..)
+, ManyAipDate(..)
, HasAipDate(..)
+, IsAipDate(..)
) where
-import Data.Aviation.Aip.Day(Day(Day), HasDay(day), parseDay)
-import Data.Aviation.Aip.Month(Month, HasMonth(month), parseMonth)
-import Data.Aviation.Aip.Year(Year(Year), HasYear(year), parseYear)
-import Text.Parser.Char(CharParsing, char)
-import Papa
-
-data AipDate =
- AipDate {
- _aipday ::
- Day
- , _aipmonth ::
- Month
- , _aipyear ::
- Year
- } deriving (Eq, Ord, Show)
-
-makeClassy ''AipDate
-
-parseAipDate ::
- (CharParsing p, Monad p) =>
- p AipDate
-parseAipDate =
- AipDate <$> parseDay <* char '-' <*> parseMonth <* char '-' <*> parseYear
-
-instance HasDay AipDate where
- day =
- aipday . day
+import Control.Category((.), id)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Char(Char)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+newtype AipDate =
+ AipDate
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON AipDate where
+ parseJSON v =
+ AipDate <$> parseJSON v
+
+instance ToJSON AipDate where
+ toJSON (AipDate x) =
+ toJSON x
+
+instance Semigroup AipDate where
+ AipDate x <> AipDate y =
+ AipDate (x <> y)
+
+instance Monoid AipDate where
+ mappend =
+ (<>)
+ mempty =
+ AipDate mempty
+
+instance Cons AipDate AipDate Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc AipDate AipDate Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each AipDate AipDate Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing AipDate where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated AipDate where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue AipDate = Char
+type instance Index AipDate = Int
+instance Ixed AipDate where
+ ix i =
+ _Wrapped . ix i
+
+instance Wrapped AipDate where
+ type Unwrapped AipDate = String
+ _Wrapped' =
+ iso
+ (\(AipDate x) -> x)
+ AipDate
+
+instance AipDate ~ a =>
+ Rewrapped AipDate a
+
+class ManyAipDate a => AsAipDate a where
+ _AipDate ::
+ Prism' a AipDate
+ default _AipDate ::
+ IsAipDate a =>
+ Prism' a AipDate
+ _AipDate =
+ _IsAipDate
+
+instance AsAipDate AipDate where
+ _AipDate =
+ id
+
+instance AsAipDate String where
+ _AipDate =
+ from _Wrapped
+
+class FoldAipDate a where
+ _FoldAipDate ::
+ Fold a AipDate
-instance HasMonth AipDate where
- month =
- aipmonth . month
+instance FoldAipDate AipDate where
+ _FoldAipDate =
+ id
-instance HasYear AipDate where
- year =
- aipyear . year
+instance FoldAipDate String where
+ _FoldAipDate =
+ from _Wrapped
-uriAipDate ::
- AipDate
- -> String
-uriAipDate (AipDate (Day d1 d2) m (Year y1 y2 y3 y4)) =
- concat
- [
- show d1
- , show d2
- , "-"
- , show m
- , "-"
- , show y1
- , show y2
- , show y3
- , show y4
- ]
+class FoldAipDate a => GetAipDate a where
+ _GetAipDate ::
+ Getter a AipDate
+ default _GetAipDate ::
+ HasAipDate a =>
+ Getter a AipDate
+ _GetAipDate =
+ aipDate
+
+instance GetAipDate AipDate where
+ _GetAipDate =
+ id
+
+instance GetAipDate String where
+ _GetAipDate =
+ from _Wrapped
+
+class SetAipDate a where
+ _SetAipDate ::
+ Setter' a AipDate
+ default _SetAipDate ::
+ ManyAipDate a =>
+ Setter' a AipDate
+ _SetAipDate =
+ _ManyAipDate
+
+instance SetAipDate AipDate where
+ _SetAipDate =
+ id
+
+instance SetAipDate String where
+ _SetAipDate =
+ from _Wrapped
+
+class (FoldAipDate a, SetAipDate a) => ManyAipDate a where
+ _ManyAipDate ::
+ Traversal' a AipDate
+
+instance ManyAipDate AipDate where
+ _ManyAipDate =
+ id
+
+instance ManyAipDate String where
+ _ManyAipDate =
+ from _Wrapped
+
+class (GetAipDate a, ManyAipDate a) => HasAipDate a where
+ aipDate ::
+ Lens' a AipDate
+ default aipDate ::
+ IsAipDate a =>
+ Lens' a AipDate
+ aipDate =
+ _IsAipDate
+
+instance HasAipDate AipDate where
+ aipDate =
+ id
+
+instance HasAipDate String where
+ aipDate =
+ from _Wrapped
+
+class (HasAipDate a, AsAipDate a) => IsAipDate a where
+ _IsAipDate ::
+ Iso' a AipDate
+
+instance IsAipDate AipDate where
+ _IsAipDate =
+ id
+
+instance IsAipDate String where
+ _IsAipDate =
+ from _Wrapped
diff --git a/src/Data/Aviation/Aip/AipDocument.hs b/src/Data/Aviation/Aip/AipDocument.hs
index ff263d7..1589058 100644
--- a/src/Data/Aviation/Aip/AipDocument.hs
+++ b/src/Data/Aviation/Aip/AipDocument.hs
@@ -1,64 +1,646 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
module Data.Aviation.Aip.AipDocument(
AipDocument(..)
-, requestAipDocument
+, AipDocument1
+, AipDocument2
+, AsAipDocument(..)
+, FoldAipDocument(..)
+, GetAipDocument(..)
+, SetAipDocument(..)
+, ManyAipDocument(..)
, HasAipDocument(..)
+, IsAipDocument(..)
+, runBook
+, runCharts
+, runSUP_AIC
+, runDAP
+, runERSA
+, runAipDocument
) where
-import Data.ByteString(ByteString)
-import qualified Data.ByteString as ByteString(writeFile)
-import Network.HTTP(Request, HasHeaders(..), rqURI)
-import System.Directory(createDirectoryIfMissing)
-import System.FilePath(takeDirectory)
-import System.IO(Handle, hPutStrLn)
-import Control.Monad.Trans.Except(runExceptT)
-import Data.Aviation.Aip.ConnErrorHttp4xx(ConnErrorHttp4xx(IsConnError, Http4xx))
-import Data.Aviation.Aip.HttpRequest(doRequest)
-import Papa
-
-data AipDocument ty =
- AipDocument {
- _aipRequest ::
- Request ty
- , _aipDocumentPath ::
- FilePath
- } deriving Show
-
-makeClassy ''AipDocument
-
-instance HasHeaders (AipDocument ty) where
- getHeaders (AipDocument r _) =
- getHeaders r
- setHeaders (AipDocument r p) h =
- AipDocument (setHeaders r h) p
-
-requestAipDocument ::
- Handle -- ^ log error
- -> Handle -- ^ log out
- -> AipDocument ByteString
- -> IO (Maybe FilePath)
-requestAipDocument err outlog (AipDocument r p) =
- do z <- runExceptT (doRequest r)
- case z of
- Left e ->
- let logmsg (IsConnError ee) =
- show ee
- logmsg (Http4xx x y) =
- concat
- [
- "HTTP error 4"
- , show x
- , show y
- , " "
- , show (rqURI r)
- ]
- in Nothing <$ hPutStrLn err (logmsg e)
- Right s ->
- do createDirectoryIfMissing True . takeDirectory $ p
- ByteString.writeFile p $ s
- hPutStrLn outlog (concat ["uri ", show (rqURI r), " created file ", p])
- pure (Just p)
+import Control.Category((.), id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Control.Monad(fail, (>=>), (>>=), join, mapM)
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Object), object, (.=))
+import Data.Aviation.Aip.Aip_SUP_and_AIC(Aip_SUP_and_AIC(Aip_SUP_and_AIC))
+import Data.Aviation.Aip.Aip_SUP_and_AICs(Aip_SUP_and_AICs(Aip_SUP_and_AICs))
+import Data.Aviation.Aip.AipCon(AipCon)
+import Data.Aviation.Aip.AipDate(AipDate(AipDate))
+import Data.Aviation.Aip.Amendment(Amendment(Amendment))
+import Data.Aviation.Aip.DAPType(DAPType', DAPType(SpecNotManTOCDAP, ChecklistTOCDAP, LegendInfoTablesTOCDAP, AeroProcChartsTOCDAP))
+import Data.Aviation.Aip.DAPEntries(DAPEntries(DAPEntries))
+import Data.Aviation.Aip.DAPEntry(DAPEntry(DAPEntry))
+import Data.Aviation.Aip.DAPDoc(DAPDoc(DAPDoc))
+import Data.Aviation.Aip.DAPDocs(DAPDocs(DAPDocs))
+import Data.Aviation.Aip.DocumentNumber(DocumentNumber(DocumentNumber))
+import Data.Aviation.Aip.Ersa(Ersa(Ersa))
+import Data.Aviation.Aip.Href(Href(Href), SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref), dropHrefFile)
+import Data.Aviation.Aip.HttpRequest(doGetRequest)
+import Data.Aviation.Aip.ListItemLink(ListItemLink(ListItemLink))
+import Data.Aviation.Aip.ListItemLinks(ListItemLinks(ListItemLinks))
+import Data.Aviation.Aip.ListItemLinks1(ListItemLinks1(ListItemLinks1))
+import Data.Aviation.Aip.ErsaAerodrome(ErsaAerodrome(ErsaAerodrome))
+import Data.Aviation.Aip.ErsaAerodromes(ErsaAerodromes(ErsaAerodromes))
+import Data.Aviation.Aip.Title(Title(Title))
+import Data.Aviation.Aip.Txt(Txt(Txt))
+import Data.Bool(Bool(True))
+import Data.Char(isSpace)
+import Data.Either(Either(Left, Right))
+import Data.Eq(Eq)
+import Data.Foldable(foldMap)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.List(isSuffixOf, dropWhile)
+import Data.List.NonEmpty(NonEmpty((:|)))
+import Data.Maybe(Maybe(Just, Nothing))
+import qualified Data.HashMap.Strict as HashMap(toList)
+import Data.Monoid(Monoid(mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Network.TCP(HStream)
+import Prelude(Show)
+import Text.HTML.TagSoup(Tag(TagText, TagOpen))
+import Text.HTML.TagSoup.Tree(TagTree(TagBranch, TagLeaf), parseTree)
+import Text.HTML.TagSoup.Tree.Zipper(TagTreePos(TagTreePos), fromTagTree, traverseTree)
+import Text.StringLike(StringLike)
+
+data AipDocument book charts sup_aic dap ersa =
+ Aip_Book Href AipDate book
+ | Aip_Charts Href AipDate charts
+ | Aip_SUP_AIC Href sup_aic
+ | Aip_Summary_SUP_AIC Href AipDate
+ | Aip_DAP Href AipDate dap
+ | Aip_DAH Href AipDate
+ | Aip_ERSA Href AipDate ersa
+ | Aip_AandB_Charts Href
+ deriving (Eq, Ord, Show)
+
+type AipDocument1 =
+ AipDocument () () () () ()
+
+type AipDocument2 =
+ AipDocument ListItemLinks ListItemLinks1 Aip_SUP_and_AICs DAPDocs Ersa
+
+class ManyAipDocument a => AsAipDocument a where
+ _AipDocument ::
+ Prism (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ default _AipDocument ::
+ IsAipDocument a =>
+ Prism (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ _AipDocument =
+ _IsAipDocument
+ _Aip_Book ::
+ Prism (a book charts sup_aic dap ersa) (a book' charts sup_aic dap ersa) (Href, AipDate, book) (Href, AipDate, book')
+ _Aip_Book =
+ _AipDocument .
+ prism
+ (\(u, t, x) -> Aip_Book u t x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Right (u, t, x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_Charts ::
+ Prism (a book charts sup_aic dap ersa) (a book charts' sup_aic dap ersa) (Href, AipDate, charts) (Href, AipDate, charts')
+ _Aip_Charts =
+ _AipDocument .
+ prism
+ (\(u, t, x) -> Aip_Charts u t x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Right (u, t, x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_SUP_AIC ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic' dap ersa) (Href, sup_aic) (Href, sup_aic')
+ _Aip_SUP_AIC =
+ _AipDocument .
+ prism
+ (\(u, x) -> Aip_SUP_AIC u x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Right (u, x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_Summary_SUP_AIC ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic dap ersa) (Href, AipDate) (Href, AipDate)
+ _Aip_Summary_SUP_AIC =
+ _AipDocument .
+ prism
+ (\(u, x) -> Aip_Summary_SUP_AIC u x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Right (u, x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_DAP ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic dap' ersa) (Href, AipDate, dap) (Href, AipDate, dap')
+ _Aip_DAP =
+ _AipDocument .
+ prism
+ (\(u, t, x) -> Aip_DAP u t x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Right (u, t, x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_DAH ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic dap ersa) (Href, AipDate) (Href, AipDate)
+ _Aip_DAH =
+ _AipDocument .
+ prism
+ (\(u, x) -> Aip_DAH u x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Right (u, x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_ERSA ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic dap ersa') (Href, AipDate, ersa) (Href, AipDate, ersa')
+ _Aip_ERSA =
+ _AipDocument .
+ prism
+ (\(u, t, x) -> Aip_ERSA u t x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Right (u, t, x)
+ Aip_AandB_Charts x ->
+ Left (Aip_AandB_Charts x))
+ _Aip_AandB_Charts ::
+ Prism (a book charts sup_aic dap ersa) (a book charts sup_aic dap ersa) Href Href
+ _Aip_AandB_Charts =
+ _AipDocument .
+ prism
+ (\x -> Aip_AandB_Charts x)
+ (\a -> case a of
+ Aip_Book u t x ->
+ Left (Aip_Book u t x)
+ Aip_Charts u t x ->
+ Left (Aip_Charts u t x)
+ Aip_SUP_AIC u x ->
+ Left (Aip_SUP_AIC u x)
+ Aip_Summary_SUP_AIC u x ->
+ Left (Aip_Summary_SUP_AIC u x)
+ Aip_DAP u t x ->
+ Left (Aip_DAP u t x)
+ Aip_DAH u x ->
+ Left (Aip_DAH u x)
+ Aip_ERSA u t x ->
+ Left (Aip_ERSA u t x)
+ Aip_AandB_Charts x ->
+ Right x)
+
+instance AsAipDocument AipDocument where
+ _AipDocument =
+ id
+
+class FoldAipDocument a where
+ _FoldAipDocument ::
+ Fold (a book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa)
+
+instance FoldAipDocument AipDocument where
+ _FoldAipDocument =
+ id
+
+class FoldAipDocument a => GetAipDocument a where
+ _GetAipDocument ::
+ Getter (a book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa)
+ default _GetAipDocument ::
+ HasAipDocument a =>
+ Getter (a book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa)
+ _GetAipDocument =
+ aipDocument
+
+instance GetAipDocument AipDocument where
+ _GetAipDocument =
+ id
+
+class SetAipDocument a where
+ _SetAipDocument ::
+ Setter (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ default _SetAipDocument ::
+ ManyAipDocument a =>
+ Setter (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ _SetAipDocument =
+ _ManyAipDocument
+
+instance SetAipDocument AipDocument where
+ _SetAipDocument =
+ id
+
+class (FoldAipDocument a, SetAipDocument a) => ManyAipDocument a where
+ _ManyAipDocument ::
+ Traversal (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+
+instance ManyAipDocument AipDocument where
+ _ManyAipDocument =
+ id
+
+class (GetAipDocument a, ManyAipDocument a) => HasAipDocument a where
+ aipDocument ::
+ Lens (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ default aipDocument ::
+ IsAipDocument a =>
+ Lens (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+ aipDocument =
+ _IsAipDocument
+
+instance HasAipDocument AipDocument where
+ aipDocument =
+ id
+
+class (HasAipDocument a, AsAipDocument a) => IsAipDocument a where
+ _IsAipDocument ::
+ Iso (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocument book charts sup_aic dap ersa) (AipDocument book' charts' sup_aic' dap' ersa')
+
+instance IsAipDocument AipDocument where
+ _IsAipDocument =
+ id
+
+instance (FromJSON book, FromJSON charts, FromJSON sup_aic, FromJSON dap, FromJSON ersa) => FromJSON (AipDocument book charts sup_aic dap ersa) where
+ parseJSON (Object z) =
+ case HashMap.toList z of
+ [("Aip_Book", q)] ->
+ (\(u, t, x) -> Aip_Book u t x) <$> parseJSON q
+ [("Aip_Charts", q)] ->
+ (\(u, t, x) -> Aip_Charts u t x) <$> parseJSON q
+ [("Aip_SUP_AIC", q)] ->
+ (\(u, x) -> Aip_SUP_AIC u x) <$> parseJSON q
+ [("Aip_Summary_SUP_AIC", q)] ->
+ (\(u, x) -> Aip_Summary_SUP_AIC u x) <$> parseJSON q
+ [("Aip_DAP", q)] ->
+ (\(u, t, x) -> Aip_DAP u t x) <$> parseJSON q
+ [("Aip_DAH", q)] ->
+ (\(u, x) -> Aip_DAH u x) <$> parseJSON q
+ [("Aip_ERSA", q)] ->
+ (\(u, t, x) -> Aip_ERSA u t x) <$> parseJSON q
+ [("Aip_AandB_Charts", q)] ->
+ Aip_AandB_Charts <$> parseJSON q
+ _ ->
+ fail "AipDocument"
+ parseJSON _ =
+ fail "AipDocument"
+
+instance (ToJSON book, ToJSON charts, ToJSON sup_aic, ToJSON dap, ToJSON ersa) => ToJSON (AipDocument book charts sup_aic dap ersa) where
+ toJSON (Aip_Book u t x) =
+ object ["Aip_Book" .= toJSON (u, t, x)]
+ toJSON (Aip_Charts u t x) =
+ object ["Aip_Charts" .= toJSON (u, t, x)]
+ toJSON (Aip_SUP_AIC u x) =
+ object ["Aip_SUP_AIC" .= toJSON (u, x)]
+ toJSON (Aip_Summary_SUP_AIC u x) =
+ object ["Aip_Summary_SUP_AIC" .= toJSON (u, x)]
+ toJSON (Aip_DAP u t x) =
+ object ["Aip_DAP" .= toJSON (u, t, x)]
+ toJSON (Aip_DAH u x) =
+ object ["Aip_DAH" .= toJSON (u, x)]
+ toJSON (Aip_ERSA u t x) =
+ object ["Aip_ERSA" .= toJSON (u, t, x)]
+ toJSON (Aip_AandB_Charts q) =
+ object ["Aip_AandB_Charts" .= toJSON q]
+
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => SetHref (AipDocument book charts sup_aic dap ersa) where
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => FoldHref (AipDocument book charts sup_aic dap ersa) where
+ _FoldHref =
+ _ManyHref
+
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => ManyHref (AipDocument book charts sup_aic dap ersa) where
+ _ManyHref f (Aip_Book u d b) =
+ Aip_Book <$> f u <*> pure d <*> _ManyHref f b
+ _ManyHref f (Aip_Charts u d c) =
+ Aip_Charts <$> f u <*> pure d <*> _ManyHref f c
+ _ManyHref f (Aip_Summary_SUP_AIC u d) =
+ Aip_Summary_SUP_AIC <$> f u <*> pure d
+ _ManyHref f (Aip_SUP_AIC u c) =
+ Aip_SUP_AIC <$> f u <*> _ManyHref f c
+ _ManyHref f (Aip_DAP u d c) =
+ Aip_DAP <$> f u <*> pure d <*> _ManyHref f c
+ _ManyHref _ (Aip_DAH u c) =
+ Aip_DAH <$> pure u <*> pure c
+ _ManyHref f (Aip_ERSA u d b) =
+ Aip_ERSA <$> f u <*> pure d <*> _ManyHref f b
+ _ManyHref _ (Aip_AandB_Charts d) =
+ Aip_AandB_Charts <$> pure d
+
+runBook ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon (AipDocument ListItemLinks charts sup_aic dap ersa)
+runBook (Aip_Book u t _) =
+ Aip_Book u t <$> traverseAipHtmlRequestGet (traverseListItems (isSuffixOf ".pdf")) u
+runBook (Aip_Charts u t x) =
+ pure (Aip_Charts u t x)
+runBook (Aip_SUP_AIC u x) =
+ pure (Aip_SUP_AIC u x)
+runBook (Aip_Summary_SUP_AIC u x) =
+ pure (Aip_Summary_SUP_AIC u x)
+runBook (Aip_DAP u t x) =
+ pure (Aip_DAP u t x)
+runBook (Aip_DAH u x) =
+ pure (Aip_DAH u x)
+runBook (Aip_ERSA u t x) =
+ pure (Aip_ERSA u t x)
+runBook (Aip_AandB_Charts x) =
+ pure (Aip_AandB_Charts x)
+
+runCharts ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon (AipDocument book ListItemLinks1 sup_aic dap ersa)
+runCharts (Aip_Book u t x) =
+ pure (Aip_Book u t x)
+runCharts (Aip_Charts u t _) =
+ do i <- traverseAipHtmlRequestGet (traverseListItems (pure True)) u
+ p <- traverse (\l@(ListItemLink u' _) ->
+ do n <- traverseAipHtmlRequestGet (traverseListItems (isSuffixOf ".pdf")) u'
+ pure (l :| n ^. _Wrapped)) (i ^. _Wrapped)
+ pure (Aip_Charts u t (ListItemLinks1 p))
+runCharts (Aip_SUP_AIC u x) =
+ pure (Aip_SUP_AIC u x)
+runCharts (Aip_Summary_SUP_AIC u x) =
+ pure (Aip_Summary_SUP_AIC u x)
+runCharts (Aip_DAP u t x) =
+ pure (Aip_DAP u t x)
+runCharts (Aip_DAH u x) =
+ pure (Aip_DAH u x)
+runCharts (Aip_ERSA u t x) =
+ pure (Aip_ERSA u t x)
+runCharts (Aip_AandB_Charts x) =
+ pure (Aip_AandB_Charts x)
+
+runSUP_AIC ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon (AipDocument book charts Aip_SUP_and_AICs dap ersa)
+runSUP_AIC (Aip_Book u t x) =
+ pure (Aip_Book u t x)
+runSUP_AIC (Aip_Charts u t x) =
+ pure (Aip_Charts u t x)
+runSUP_AIC (Aip_SUP_AIC u _) =
+ let traverseAip_SUP_AIC ::
+ TagTreePos String
+ -> Aip_SUP_and_AICs
+ traverseAip_SUP_AIC (TagTreePos (TagBranch "tr" _ (TagLeaf (TagText _) : TagBranch "td" [] [TagLeaf (TagText docnum)] : TagLeaf (TagText _): TagBranch "td" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText title)]] : TagLeaf (TagText _) : TagBranch "td" [("align","center")] [TagLeaf (TagText pubdate)] : TagLeaf (TagText _) : TagBranch "td" [("align","center")] [TagLeaf (TagText effdate)] : _)) _ _ _) =
+ Aip_SUP_and_AICs [Aip_SUP_and_AIC (DocumentNumber docnum) (Href hf) (Title title) (AipDate pubdate) (AipDate effdate)]
+ traverseAip_SUP_AIC _ =
+ mempty
+ in Aip_SUP_AIC u <$> traverseAipHtmlRequestGet traverseAip_SUP_AIC u
+runSUP_AIC (Aip_Summary_SUP_AIC u x) =
+ pure (Aip_Summary_SUP_AIC u x)
+runSUP_AIC (Aip_DAP u t x) =
+ pure (Aip_DAP u t x)
+runSUP_AIC (Aip_DAH u x) =
+ pure (Aip_DAH u x)
+runSUP_AIC (Aip_ERSA u t x) =
+ pure (Aip_ERSA u t x)
+runSUP_AIC (Aip_AandB_Charts x) =
+ pure (Aip_AandB_Charts x)
+
+runDAP ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon (AipDocument book charts sup_aic DAPDocs ersa)
+runDAP (Aip_Book u t x) =
+ pure (Aip_Book u t x)
+runDAP (Aip_Charts u t x) =
+ pure (Aip_Charts u t x)
+runDAP (Aip_SUP_AIC u x) =
+ pure (Aip_SUP_AIC u x)
+runDAP (Aip_Summary_SUP_AIC u x) =
+ pure (Aip_Summary_SUP_AIC u x)
+runDAP (Aip_DAP u t _) =
+ let eachDAP ::
+ AipCon DAPDocs
+ eachDAP =
+ let trimSpaces =
+ dropWhile isSpace
+ traverseDAP ::
+ TagTreePos String
+ -> [(DAPType', Href)]
+ traverseDAP (TagTreePos (TagBranch "li" [] [TagBranch "a" [("href", hrefSpecNotManTOC)] [TagLeaf (TagText "Special Notices & Manuscript")]]) _ _ _) =
+ [(SpecNotManTOCDAP, Href hrefSpecNotManTOC)]
+ traverseDAP (TagTreePos (TagBranch "li" [] [TagBranch "a" [("href", hrefChecklistTOC)] [TagLeaf (TagText "Checklist")]]) _ _ _) =
+ [(ChecklistTOCDAP, Href hrefChecklistTOC)]
+
+ traverseDAP (TagTreePos (TagBranch "li" [] [TagBranch "a" [("href", hrefLegendInfoTablesTOC)] [TagLeaf (TagText "Legend. Info & Tables")]]) _ _ _) =
+ [(LegendInfoTablesTOCDAP, Href hrefLegendInfoTablesTOC)]
+
+ traverseDAP (TagTreePos (TagBranch "li" [] [TagBranch "a" [("href", hrefAeroProcChartsTOC)] [TagLeaf (TagText "Aerodrome & Procedure Charts")]]) _ _ _) =
+ [(AeroProcChartsTOCDAP (), Href hrefAeroProcChartsTOC)]
+ traverseDAP _ =
+ []
+ traverseDAP2 ::
+ Href
+ -> TagTreePos String
+ -> DAPEntries
+ traverseDAP2 u' (TagTreePos (TagBranch "tr" [] [TagLeaf (TagText _),TagLeaf (TagOpen "td" _),TagLeaf (TagText _),TagBranch "td" _ [TagBranch "a" [("href",hf)] [TagLeaf (TagText tx)]],TagLeaf (TagText _),TagBranch "td" _ [TagLeaf (TagText date),TagBranch "span" _ [TagLeaf (TagText amend)]],TagLeaf (TagText _)]) _ _ _) =
+ DAPEntries [DAPEntry (dropHrefFile u' <> Href hf) (Txt tx) (AipDate date) (Amendment (trimSpaces amend))]
+ traverseDAP2 _ _ =
+ mempty
+ traverseAeroProcChartsTOCDAP ::
+ Href
+ -> TagTreePos String
+ -> [(String, DAPEntries)]
+ traverseAeroProcChartsTOCDAP u' (TagTreePos (TagBranch "h3" _ [TagLeaf (TagText aerodrome)]) _ (TagLeaf (TagText _) : TagBranch "table" _ es : _) _) =
+ [(aerodrome, _Wrapped # (fromTagTree <$> es >>= (^. _Wrapped) . traverseTree (traverseDAP2 u')))]
+ traverseAeroProcChartsTOCDAP _ _ =
+ mempty
+ in do dap1 <- traverseAipHtmlRequestGet traverseDAP u
+ let ts ::
+ (DAPType', Href)
+ -> AipCon [DAPDoc]
+ ts (t', u') =
+ let noaerodrome dt =
+ (\x -> [DAPDoc dt u' x]) <$> traverseAipHtmlRequestGet (traverseDAP2 u') u'
+ in case t' of
+ SpecNotManTOCDAP ->
+ noaerodrome SpecNotManTOCDAP
+ ChecklistTOCDAP ->
+ noaerodrome ChecklistTOCDAP
+ LegendInfoTablesTOCDAP ->
+ noaerodrome LegendInfoTablesTOCDAP
+ AeroProcChartsTOCDAP () ->
+ do f <- doGetRequest u' ""
+ let es ::
+ TagTree String
+ -> [(String, DAPEntries)]
+ es =
+ traverseTree (traverseAeroProcChartsTOCDAP u') . fromTagTree
+ docs ::
+ [DAPDoc]
+ docs =
+ parseTree f >>= \x ->
+ es x >>= \(s', e') ->
+ pure (DAPDoc (AeroProcChartsTOCDAP s') u' e')
+ pure docs
+ DAPDocs . join <$> mapM ts dap1
+ in Aip_DAP u t <$> eachDAP
+runDAP (Aip_DAH u x) =
+ pure (Aip_DAH u x)
+runDAP (Aip_ERSA u t x) =
+ pure (Aip_ERSA u t x)
+runDAP (Aip_AandB_Charts x) =
+ pure (Aip_AandB_Charts x)
+
+runERSA ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon (AipDocument book charts sup_aic dap Ersa)
+runERSA (Aip_Book u t x) =
+ pure (Aip_Book u t x)
+runERSA (Aip_Charts u t x) =
+ pure (Aip_Charts u t x)
+runERSA (Aip_SUP_AIC u x) =
+ pure (Aip_SUP_AIC u x)
+runERSA (Aip_Summary_SUP_AIC u x) =
+ pure (Aip_Summary_SUP_AIC u x)
+runERSA (Aip_DAP u t x) =
+ pure (Aip_DAP u t x)
+runERSA (Aip_DAH u x) =
+ pure (Aip_DAH u x)
+runERSA (Aip_ERSA u t _) =
+ let traverseErsaAerodromes ::
+ TagTreePos String
+ -> ErsaAerodromes
+ traverseErsaAerodromes (TagTreePos (TagBranch "tr" [] (TagLeaf (TagText _) : TagBranch "td" _ [TagLeaf (TagText aerodrome)] : TagLeaf (TagText _) : TagBranch "td" _ [TagLeaf (TagText _), TagBranch "a" [("href", fac_href)] [TagLeaf (TagText "FAC")], TagLeaf (TagText _)] : r)) _ _ _) =
+ ErsaAerodromes [
+ ErsaAerodrome
+ aerodrome
+ (Href fac_href) $
+ case r of
+ TagLeaf (TagText _) : TagBranch "td" _ [TagLeaf (TagText _), TagBranch "a" [("href", rds_href)] [TagLeaf (TagText "RDS")], TagLeaf (TagText _)] : _ : _ ->
+ Just (Href rds_href)
+ _ ->
+ Nothing]
+ traverseErsaAerodromes _ =
+ ErsaAerodromes []
+ traverseErsaDocs ::
+ TagTreePos String
+ -> ListItemLinks
+ traverseErsaDocs =
+ traverseListItems (isSuffixOf ".pdf")
+ traverseErsaCompletes ::
+ TagTreePos String
+ -> [Href]
+ traverseErsaCompletes (TagTreePos (TagBranch "td" _ [TagLeaf (TagText _),TagBranch "a" [("href", u')] [TagLeaf (TagText "ERSA Complete")],TagLeaf (TagText _)]) _ _ _) =
+ [Href u' ]
+ traverseErsaCompletes _ =
+ []
+ in Aip_ERSA u t <$> traverseAipHtmlRequestGet (Ersa <$> traverseErsaDocs <*> traverseErsaAerodromes <*> traverseErsaCompletes) u
+runERSA (Aip_AandB_Charts x) =
+ pure (Aip_AandB_Charts x)
+
+runAipDocument ::
+ AipDocument book charts sup_aic dap ersa
+ -> AipCon AipDocument2
+runAipDocument =
+ runBook >=> runCharts >=> runSUP_AIC >=> runDAP >=> runERSA
+
+traverseListItems ::
+ (String -> Bool)
+ -> TagTreePos String
+ -> ListItemLinks
+traverseListItems p (TagTreePos (TagBranch "ul" [] x) _ _ _) =
+ let li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText tx)]]) =
+ if p hf
+ then
+ [ListItemLink (Href hf) (Txt tx)]
+ else
+ []
+ li _ =
+ []
+ in ListItemLinks (x >>= li)
+traverseListItems _ _ =
+ ListItemLinks []
+
+traverseAipHtmlRequestGet ::
+ (HStream str, Monoid a, Text.StringLike.StringLike str) =>
+ (TagTreePos str -> a)
+ -> Href
+ -> AipCon a
+traverseAipHtmlRequestGet k (Href u) =
+ foldMap (traverseTree k . fromTagTree) . parseTree <$> doGetRequest (Href u) ""
diff --git a/src/Data/Aviation/Aip/AipDocuments.hs b/src/Data/Aviation/Aip/AipDocuments.hs
index f7a578b..5ae74eb 100644
--- a/src/Data/Aviation/Aip/AipDocuments.hs
+++ b/src/Data/Aviation/Aip/AipDocuments.hs
@@ -1,1197 +1,190 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
module Data.Aviation.Aip.AipDocuments(
AipDocuments(..)
-, writeAipDocuments
-, requestAipDocuments
-, getAipDocuments
+, AipDocuments1
+, AipDocuments2
+, AsAipDocuments(..)
+, FoldAipDocuments(..)
+, GetAipDocuments(..)
+, SetAipDocuments(..)
+, ManyAipDocuments(..)
+, HasAipDocuments(..)
+, IsAipDocuments(..)
) where
-import Control.Monad.IO.Class(liftIO)
-import Data.ByteString(ByteString)
-import Data.Maybe(maybeToList)
-import System.FilePath((</>))
-import System.IO(Handle)
-import Control.Monad.Trans.Except(ExceptT)
-import Data.Aviation.Aip.AipDate(uriAipDate)
-import Data.Aviation.Aip.AipDocument(AipDocument(AipDocument), requestAipDocument)
-import Data.Aviation.Aip.ConnErrorHttp4xx(ConnErrorHttp4xx)
-import Data.Aviation.Aip.Ersa(Ersa(Ersa))
-import Data.Aviation.Aip.Ersas(Ersas(Ersas), parseAipTree)
-import Data.Aviation.Aip.HttpRequest(requestAipContents, aipRequestGet)
-import Papa
+import Control.Category((.), id)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.Aip_SUP_and_AICs(Aip_SUP_and_AICs)
+import Data.Aviation.Aip.AipDocument(AipDocument)
+import Data.Aviation.Aip.DAPDocs(DAPDocs)
+import Data.Aviation.Aip.Ersa(Ersa)
+import Data.Aviation.Aip.Href(SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref))
+import Data.Aviation.Aip.ListItemLinks(ListItemLinks)
+import Data.Aviation.Aip.ListItemLinks1(ListItemLinks1)
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
-newtype AipDocuments ty =
+newtype AipDocuments book charts sup_aic dap ersa =
AipDocuments
- [AipDocument ty]
- deriving Show
+ [AipDocument book charts sup_aic dap ersa]
+ deriving (Eq, Ord, Show)
-makeWrapped ''AipDocuments
+instance Semigroup (AipDocuments book charts sup_aic dap ersa) where
+ AipDocuments x <> AipDocuments y =
+ AipDocuments (x <> y)
-writeAipDocuments ::
- Handle -- ^ log error
- -> Handle -- ^ log out
- -> FilePath
- -> ExceptT ConnErrorHttp4xx IO [FilePath]
-writeAipDocuments errlog outlog dir =
- requestAipContents >>= liftIO . requestAipDocuments errlog outlog . getAipDocuments dir . parseAipTree
+instance Monoid (AipDocuments book charts sup_aic dap ersa) where
+ mappend =
+ (<>)
+ mempty =
+ AipDocuments []
-requestAipDocuments ::
- Handle -- ^ log error
- -> Handle -- ^ log out
- -> AipDocuments ByteString
- -> IO [FilePath]
-requestAipDocuments errlog outlog (AipDocuments ds) =
- (>>= maybeToList) <$> mapM (requestAipDocument errlog outlog) ds
+instance Wrapped (AipDocuments book charts sup_aic dap ersa) where
+ type Unwrapped (AipDocuments book charts sup_aic dap ersa) =
+ [AipDocument book charts sup_aic dap ersa]
+ _Wrapped' =
+ iso (\(AipDocuments x) -> x) AipDocuments
-getAipDocuments ::
- FilePath -- output directory
- -> Ersas
- -> AipDocuments ByteString
-getAipDocuments dir (Ersas ersas) =
- let simpleAipDocuments =
- [
- -- AIP Book
- "aip/complete.pdf"
- , "aip/general.pdf"
- , "aip/enroute.pdf"
- , "aip/aerodrome.pdf"
- , "aip/cover.pdf"
- , "aip/index.pdf"
- -- AIP Charts (current)
- , "aipchart/erch/erch1.pdf"
- , "aipchart/erch/erch2.pdf"
- , "aipchart/erch/erch3.pdf"
- , "aipchart/erch/erch4.pdf"
- , "aipchart/erch/erch5.pdf"
- , "aipchart/ercl/ercl1.pdf"
- , "aipchart/ercl/ercl2.pdf"
- , "aipchart/ercl/ercl3.pdf"
- , "aipchart/ercl/ercl4.pdf"
- , "aipchart/ercl/ercl5.pdf"
- , "aipchart/ercl/ercl6.pdf"
- , "aipchart/ercl/ercl7.pdf"
- , "aipchart/ercl/ercl8.pdf"
- , "aipchart/pca/PCA_back.pdf"
- , "aipchart/pca/PCA_front.pdf"
- , "aipchart/tac/tac1.pdf"
- , "aipchart/tac/tac2.pdf"
- , "aipchart/tac/tac3.pdf"
- , "aipchart/tac/tac4.pdf"
- , "aipchart/tac/tac5.pdf"
- , "aipchart/tac/tac6.pdf"
- , "aipchart/tac/tac7.pdf"
- , "aipchart/tac/tac8.pdf"
- , "aipchart/vnc/Adelaide_VNC.pdf"
- , "aipchart/vnc/Brisbane_VNC.pdf"
- , "aipchart/vnc/Bundaberg_VNC.pdf"
- , "aipchart/vnc/Cairns_VNC.pdf"
- , "aipchart/vnc/Darwin_VNC.pdf"
- , "aipchart/vnc/Deniliquin_VNC.pdf"
- , "aipchart/vnc/Hobart_VNC.pdf"
- , "aipchart/vnc/Launceston_VNC.pdf"
- , "aipchart/vnc/Melbourne_VNC.pdf"
- , "aipchart/vnc/Newcastle_VNC.pdf"
- , "aipchart/vnc/Perth_VNC.pdf"
- , "aipchart/vnc/Rockhampton_VNC.pdf"
- , "aipchart/vnc/Sydney_VNC.pdf"
- , "aipchart/vnc/Tindal_VNC.pdf"
- , "aipchart/vnc/Townsville_VNC.pdf"
- , "aipchart/vtc/Adelaide_VTC.pdf"
- , "aipchart/vtc/Albury_VTC.pdf"
- , "aipchart/vtc/AliceSprings_Uluru_VTC.pdf"
- , "aipchart/vtc/Brisbane_Sunshine_VTC.pdf"
- , "aipchart/vtc/Broome_VTC.pdf"
- , "aipchart/vtc/Cairns_VTC.pdf"
- , "aipchart/vtc/Canberra_VTC.pdf"
- , "aipchart/vtc/Coffs_Harbour_VTC.pdf"
- , "aipchart/vtc/Darwin_VTC.pdf"
- , "aipchart/vtc/Gold_Coast_VTC.pdf"
- , "aipchart/vtc/Hobart_VTC.pdf"
- , "aipchart/vtc/Karratha_VTC.pdf"
- , "aipchart/vtc/Launceston_VTC.pdf"
- , "aipchart/vtc/Mackay_VTC.pdf"
- , "aipchart/vtc/Melbourne_VTC.pdf"
- , "aipchart/vtc/Newcastle_Williamtown_VTC.pdf"
- , "aipchart/vtc/Oakey_Bris_VTC.pdf"
- , "aipchart/vtc/perth_legend.pdf"
- , "aipchart/vtc/Perth_VTC.pdf"
- , "aipchart/vtc/Rockhampton_VTC.pdf"
- , "aipchart/vtc/Sydney_VTC.pdf"
- , "aipchart/vtc/Tamworth_VTC.pdf"
- , "aipchart/vtc/Townsville_VTC.pdf"
- , "aipchart/vtc/Whitsunday_VTC.pdf"
- -- DAP
- , "dap/SpecNotManTOC.htm"
- , "dap/ChecklistTOC.htm"
- , "dap/LegendInfoTablesTOC.htm"
- , "dap/AeroProcChartsTOC.htm"
- -- DAH
- , "dah/dah.pdf"
- -- Precision Approach Terrain Charts and Type A & Type B Obstacle Charts
- , "chart/TypeAandBCharts.pdf"
- ]
- ersaprelim =
- [
- "GUID_ersa-fac-1-3"
- , "GUID_ersa-fac-1-4"
- , "GUID_ersa-fac-1-5"
- , "PRD_"
- , "LND_"
- , "IFR_"
- , "VFR_"
- , "GUID_ersa-fac-2-2"
- , "GUID_ersa-fac-2-3"
- , "GUID_ersa-fac-2-4"
- , "GUID_ersa-fac-2-5"
- , "GUID_ersa-fac-2-6"
- , "GUID_ersa-fac-2-7"
- , "GUID_ersa-fac-2-8"
- , "GUID_ersa-fac-2-9"
- , "GUID_ersa-fac-2-10"
- , "GUID_ersa-fac-2-11"
- , "GUID_ersa-fac-2-12"
- , "GUID_ersa-fac-2-14"
- ]
- ersafac =
- [
- "FAC_YADY"
- , "FAC_ADAC"
- , "FAC_YPAD"
- , "FAC_YPPF"
- , "FAC_YALG"
- , "FAC_YABA"
- , "FAC_YMAY"
- , "FAC_YADG"
- , "FAC_YBAS"
- , "FAC_YAPH"
- , "FAC_YAMT"
- , "FAC_YAMB"
- , "FAC_YANK"
- , "FAC_YAMC"
- , "FAC_YARA"
- , "FAC_YARS"
- , "FAC_YARG"
- , "FAC_YARK"
- , "FAC_YARM"
- , "FAC_YARY"
- , "FAC_YATN"
- , "FAC_YAUG"
- , "FAC_YAGD"
- , "FAC_YAUR"
- , "FAC_YMAV"
- , "FAC_YAYE"
- , "FAC_YAYR"
- , "FAC_YBSS"
- , "FAC_YBAU"
- , "FAC_YBNS"
- , "FAC_YBLC"
- , "FAC_YBGO"
- , "FAC_YBLT"
- , "FAC_YLLE"
- , "FAC_YBIU"
- , "FAC_YBNA"
- , "FAC_YBRN"
- , "FAC_YBMY"
- , "FAC_YBAD"
- , "FAC_YBAB"
- , "FAC_YBAR"
- , "FAC_YBRY"
- , "FAC_YBWX"
- , "FAC_YBRS"
- , "FAC_YBYL"
- , "FAC_YBTH"
- , "FAC_YBTI"
- , "FAC_YBFT"
- , "FAC_YBIE"
- , "FAC_YBEB"
- , "FAC_YBLU"
- , "FAC_YBLA"
- , "FAC_YBDG"
- , "FAC_YBEO"
- , "FAC_YBEE"
- , "FAC_YBYS"
- , "FAC_YBHL"
- , "FAC_YBIR"
- , "FAC_YBDV"
- , "FAC_YBCK"
- , "FAC_YBTR"
- , "FAC_YBLP"
- , "FAC_YBOI"
- , "FAC_YBLL"
- , "FAC_YBOM"
- , "FAC_YBOC"
- , "FAC_YBGD"
- , "FAC_YBMI"
- , "FAC_YBOA"
- , "FAC_YBBT"
- , "FAC_YBOR"
- , "FAC_YBRL"
- , "FAC_YBOU"
- , "FAC_YBKE"
- , "FAC_YBWN"
- , "FAC_YBPI"
- , "FAC_YBRW"
- , "FAC_YBGR"
- , "FAC_BNAC"
- , "FAC_YBWW"
- , "FAC_YBBN"
- , "FAC_YBAF"
- , "FAC_YBHI"
- , "FAC_BML"
- , "FAC_YBRM"
- , "FAC_YBUN"
- , "FAC_YBUD"
- , "FAC_YBKT"
- , "FAC_YBLN"
- , "FAC_YCAB"
- , "FAC_YCDH"
- , "FAC_YCAG"
- , "FAC_YBCS"
- , "FAC_YCDR"
- , "FAC_YCVG"
- , "FAC_YSCN"
- , "FAC_YCMH"
- , "FAC_YCMW"
- , "FAC_YSCB"
- , "FAC_YCLQ"
- , "FAC_YCEL"
- , "FAC_YCAV"
- , "FAC_YCDW"
- , "FAC_YCAR"
- , "FAC_YCAS"
- , "FAC_YCTN"
- , "FAC_YCDU"
- , "FAC_YCNY"
- , "FAC_YCES"
- , "FAC_YCNK"
- , "FAC_YBCV"
- , "FAC_YCHT"
- , "FAC_YCGO"
- , "FAC_YCCA"
- , "FAC_YCHK"
- , "FAC_YPXM"
- , "FAC_YCVA"
- , "FAC_YCMT"
- , "FAC_YCEE"
- , "FAC_YCFN"
- , "FAC_YCCY"
- , "FAC_YUNY"
- , "FAC_YCBA"
- , "FAC_YCDE"
- , "FAC_YCCT"
- , "FAC_YPCC"
- , "FAC_YCOE"
- , "FAC_YCFS"
- , "FAC_YCOH"
- , "FAC_YOLA"
- , "FAC_YCEM"
- , "FAC_YCBR"
- , "FAC_YCSV"
- , "FAC_YCDO"
- , "FAC_YCBP"
- , "FAC_YCOO"
- , "FAC_YCKN"
- , "FAC_YCAH"
- , "FAC_YCXA"
- , "FAC_YPFT"
- , "FAC_YCOM"
- , "FAC_YBCM"
- , "FAC_YCBB"
- , "FAC_YCNM"
- , "FAC_YCWA"
- , "FAC_YCTM"
- , "FAC_YCOR"
- , "FAC_YCRG"
- , "FAC_YCWL"
- , "FAC_YCWR"
- , "FAC_YCRN"
- , "FAC_YCKI"
- , "FAC_YCRL"
- , "FAC_YCRY"
- , "FAC_YCUE"
- , "FAC_YCMM"
- , "FAC_YCUN"
- , "FAC_YCMU"
- , "FAC_YCIN"
- , "FAC_YDAY"
- , "FAC_YDLO"
- , "FAC_YDNI"
- , "FAC_DNAC"
- , "FAC_YPDN"
- , "FAC_YDPD"
- , "FAC_YDGU"
- , "FAC_YDWF"
- , "FAC_YDLV"
- , "FAC_YDLT"
- , "FAC_YDLQ"
- , "FAC_YDEK"
- , "FAC_YDBY"
- , "FAC_YDPO"
- , "FAC_YDBI"
- , "FAC_YDOC"
- , "FAC_YDVR"
- , "FAC_YDOD"
- , "FAC_YDOP"
- , "FAC_YDMG"
- , "FAC_YDOR"
- , "FAC_YDRN"
- , "FAC_YDRD"
- , "FAC_YSDU"
- , "FAC_YDKG"
- , "FAC_YDBR"
- , "FAC_YDKI"
- , "FAC_YDUN"
- , "FAC_YDRH"
- , "FAC_YDRI"
- , "FAC_YDYS"
- , "FAC_YEJI"
- , "FAC_YMES"
- , "FAC_YECH"
- , "FAC_YECB"
- , "FAC_YPED"
- , "FAC_YESD"
- , "FAC_YELD"
- , "FAC_YEQY"
- , "FAC_YELN"
- , "FAC_YESE"
- , "FAC_YEML"
- , "FAC_YMKT"
- , "FAC_YEMP"
- , "FAC_YENO"
- , "FAC_YEHP"
- , "FAC_YERN"
- , "FAC_YEMG"
- , "FAC_YESC"
- , "FAC_YESP"
- , "FAC_YEUO"
- , "FAC_YEUA"
- , "FAC_YEVD"
- , "FAC_YEXM"
- , "FAC_YFDN"
- , "FAC_YFTZ"
- , "FAC_YFLI"
- , "FAC_YFBS"
- , "FAC_YFRT"
- , "FAC_YFTA"
- , "FAC_YFDF"
- , "FAC_YFRG"
- , "FAC_YGAD"
- , "FAC_YGPT"
- , "FAC_YGAS"
- , "FAC_YGAW"
- , "FAC_YGAY"
- , "FAC_YGTO"
- , "FAC_YGTN"
- , "FAC_YGEL"
- , "FAC_YGIB"
- , "FAC_YGLS"
- , "FAC_YGIL"
- , "FAC_YGIA"
- , "FAC_YGIG"
- , "FAC_YGLA"
- , "FAC_YGLI"
- , "FAC_YGNB"
- , "FAC_YGLO"
- , "FAC_YBCG"
- , "FAC_YGGE"
- , "FAC_YGDA"
- , "FAC_YGWA"
- , "FAC_YGDI"
- , "FAC_YGLB"
- , "FAC_YPGV"
- , "FAC_YGFN"
- , "FAC_YGRS"
- , "FAC_YGKL"
- , "FAC_YGRL"
- , "FAC_YGDS"
- , "FAC_YGTH"
- , "FAC_YGTE"
- , "FAC_YGDO"
- , "FAC_YGDH"
- , "FAC_YGYM"
- , "FAC_YHAA"
- , "FAC_YHLC"
- , "FAC_YHML"
- , "FAC_YBHM"
- , "FAC_YHAW"
- , "FAC_YHAY"
- , "FAC_YHEC"
- , "FAC_YHCS"
- , "FAC_YHMB"
- , "FAC_YHBA"
- , "FAC_YHLS"
- , "FAC_YMHB"
- , "FAC_YCBG"
- , "FAC_YHBK"
- , "FAC_YSHW"
- , "FAC_YHON"
- , "FAC_YHOO"
- , "FAC_YHPN"
- , "FAC_YHID"
- , "FAC_YHSM"
- , "FAC_YHUG"
- , "FAC_YHRD"
- , "FAC_YIFY"
- , "FAC_YILF"
- , "FAC_YIGM"
- , "FAC_YINJ"
- , "FAC_YIKM"
- , "FAC_YINN"
- , "FAC_YIMT"
- , "FAC_YIFL"
- , "FAC_YIVL"
- , "FAC_YISF"
- , "FAC_YIVO"
- , "FAC_YJAB"
- , "FAC_YJAC"
- , "FAC_YJST"
- , "FAC_YJER"
- , "FAC_YJBY"
- , "FAC_YJIN"
- , "FAC_YJLC"
- , "FAC_YJDA"
- , "FAC_YJUN"
- , "FAC_YJNB"
- , "FAC_YKDI"
- , "FAC_YKBR"
- , "FAC_YPKG"
- , "FAC_YKKG"
- , "FAC_YKAL"
- , "FAC_YKBL"
- , "FAC_YKML"
- , "FAC_YKAR"
- , "FAC_YPKA"
- , "FAC_YKMB"
- , "FAC_YKNG"
- , "FAC_YKAT"
- , "FAC_YKMP"
- , "FAC_YKER"
- , "FAC_YKHO"
- , "FAC_YKDM"
- , "FAC_YKID"
- , "FAC_YKCY"
- , "FAC_YKLE"
- , "FAC_YIMB"
- , "FAC_YKKN"
- , "FAC_YKII"
- , "FAC_YKRY"
- , "FAC_YKCS"
- , "FAC_YKSC"
- , "FAC_YKIG"
- , "FAC_YKBN"
- , "FAC_YKOW"
- , "FAC_YKUB"
- , "FAC_YPKU"
- , "FAC_YKTN"
- , "FAC_YLCG"
- , "FAC_YLEV"
- , "FAC_YLJN"
- , "FAC_YKEP"
- , "FAC_YLMQ"
- , "FAC_YLKE"
- , "FAC_YLAK"
- , "FAC_YLCK"
- , "FAC_YLTV"
- , "FAC_YMLT"
- , "FAC_YLTN"
- , "FAC_YLAW"
- , "FAC_YLAH"
- , "FAC_YPLM"
- , "FAC_YLGU"
- , "FAC_YLEC"
- , "FAC_YLST"
- , "FAC_YLEG"
- , "FAC_YLEO"
- , "FAC_YLED"
- , "FAC_YLRD"
- , "FAC_YLIL"
- , "FAC_YLIS"
- , "FAC_YLZI"
- , "FAC_YLHR"
- , "FAC_YLCS"
- , "FAC_YLRE"
- , "FAC_YLHI"
- , "FAC_YLOR"
- , "FAC_YLOH"
- , "FAC_YLOX"
- , "FAC_YLYK"
- , "FAC_YMAA"
- , "FAC_YBMK"
- , "FAC_YMND"
- , "FAC_YMLD"
- , "FAC_YMCO"
- , "FAC_YMNG"
- , "FAC_YMGD"
- , "FAC_YMJM"
- , "FAC_YMFD"
- , "FAC_YMBL"
- , "FAC_YMBA"
- , "FAC_YMGT"
- , "FAC_YMGR"
- , "FAC_YALA"
- , "FAC_YMRE"
- , "FAC_YMYB"
- , "FAC_YMBU"
- , "FAC_YMHU"
- , "FAC_YMEK"
- , "FAC_MLAC"
- , "FAC_YMML"
- , "FAC_YMEN"
- , "FAC_YMMB"
- , "FAC_YMEL"
- , "FAC_YMET"
- , "FAC_YMEI"
- , "FAC_YMER"
- , "FAC_YMDN"
- , "FAC_YMMU"
- , "FAC_YMIA"
- , "FAC_YMLS"
- , "FAC_YMGB"
- , "FAC_YMIO"
- , "FAC_YMCT"
- , "FAC_YMMN"
- , "FAC_YMDR"
- , "FAC_YMPA"
- , "FAC_YMIB"
- , "FAC_YMIT"
- , "FAC_YITT"
- , "FAC_YMIG"
- , "FAC_YMMO"
- , "FAC_YMOD"
- , "FAC_YMNK"
- , "FAC_YMTO"
- , "FAC_YOOM"
- , "FAC_YMOO"
- , "FAC_YMRB"
- , "FAC_YMRW"
- , "FAC_YMOR"
- , "FAC_YMNY"
- , "FAC_YMTI"
- , "FAC_YMRY"
- , "FAC_YMBT"
- , "FAC_YMDY"
- , "FAC_YMCL"
- , "FAC_YMTG"
- , "FAC_YGON"
- , "FAC_YMHL"
- , "FAC_YHOT"
- , "FAC_YMHO"
- , "FAC_YMHW"
- , "FAC_YBMA"
- , "FAC_YMNE"
- , "FAC_YMOG"
- , "FAC_YMSF"
- , "FAC_YMOU"
- , "FAC_YMDG"
- , "FAC_YMWA"
- , "FAC_YMDA"
- , "FAC_YMGI"
- , "FAC_YLMU"
- , "FAC_YMRG"
- , "FAC_YMBD"
- , "FAC_YMUL"
- , "FAC_YMAE"
- , "FAC_YMMI"
- , "FAC_YMUR"
- , "FAC_YMTB"
- , "FAC_YMYU"
- , "FAC_YNKR"
- , "FAC_YNGW"
- , "FAC_YNAP"
- , "FAC_YNRC"
- , "FAC_YNRB"
- , "FAC_YNBR"
- , "FAC_YNAR"
- , "FAC_YNRG"
- , "FAC_YNRM"
- , "FAC_YNEY"
- , "FAC_YNRH"
- , "FAC_YNWN"
- , "FAC_YNGU"
- , "FAC_YNHL"
- , "FAC_YCNF"
- , "FAC_YNSH"
- , "FAC_YSNF"
- , "FAC_YNTN"
- , "FAC_YNSM"
- , "FAC_YNWF"
- , "FAC_YNTM"
- , "FAC_YNPE"
- , "FAC_YNOV"
- , "FAC_YSNW"
- , "FAC_YNUL"
- , "FAC_YNUB"
- , "FAC_YNUM"
- , "FAC_YNYN"
- , "FAC_YBOK"
- , "FAC_YOAY"
- , "FAC_YOCA"
- , "FAC_YOEN"
- , "FAC_YOLD"
- , "FAC_YOLW"
- , "FAC_YOOD"
- , "FAC_YORG"
- , "FAC_YOEH"
- , "FAC_YORB"
- , "FAC_YORR"
- , "FAC_YOSB"
- , "FAC_YPAC"
- , "FAC_YPAM"
- , "FAC_YPAY"
- , "FAC_YPBO"
- , "FAC_YPKS"
- , "FAC_YPEA"
- , "FAC_YPEF"
- , "FAC_PHAC"
- , "FAC_YPPH"
- , "FAC_YPJT"
- , "FAC_YPTB"
- , "FAC_YPBH"
- , "FAC_YPID"
- , "FAC_YPNN"
- , "FAC_YPWH"
- , "FAC_YPLU"
- , "FAC_YMPC"
- , "FAC_YPCE"
- , "FAC_YPOK"
- , "FAC_YPMP"
- , "FAC_YPAG"
- , "FAC_POCA"
- , "FAC_YPPD"
- , "FAC_YPKT"
- , "FAC_YPLC"
- , "FAC_YPMQ"
- , "FAC_YPIR"
- , "FAC_YPOD"
- , "FAC_YPMH"
- , "FAC_YBPN"
- , "FAC_YPKL"
- , "FAC_YPUG"
- , "FAC_YQNS"
- , "FAC_YQLP"
- , "FAC_YQDI"
- , "FAC_YQRN"
- , "FAC_YRNG"
- , "FAC_YNRV"
- , "FAC_YRYP"
- , "FAC_YRED"
- , "FAC_YREN"
- , "FAC_YSRI"
- , "FAC_YRMD"
- , "FAC_YRID"
- , "FAC_YRBE"
- , "FAC_YRBK"
- , "FAC_YROB"
- , "FAC_YROI"
- , "FAC_YBRK"
- , "FAC_YRLL"
- , "FAC_YROM"
- , "FAC_YRSY"
- , "FAC_YRAY"
- , "FAC_YRSB"
- , "FAC_YRSH"
- , "FAC_YRTI"
- , "FAC_YRNS"
- , "FAC_YRPA"
- , "FAC_YRTP"
- , "FAC_YRYL"
- , "FAC_YSII"
- , "FAC_YSTA"
- , "FAC_YSGE"
- , "FAC_YSTH"
- , "FAC_YSAM"
- , "FAC_YBSG"
- , "FAC_YSCO"
- , "FAC_YSCA"
- , "FAC_YSLK"
- , "FAC_YSEN"
- , "FAC_YSHK"
- , "FAC_YSHG"
- , "FAC_YSHT"
- , "FAC_YSHR"
- , "FAC_YSGT"
- , "FAC_YSMI"
- , "FAC_YSNB"
- , "FAC_YSOL"
- , "FAC_YSMB"
- , "FAC_YSGW"
- , "FAC_YGBI"
- , "FAC_YSGR"
- , "FAC_YSCR"
- , "FAC_YSPT"
- , "FAC_YSPK"
- , "FAC_YSPI"
- , "FAC_YSPE"
- , "FAC_YSWL"
- , "FAC_YSFG"
- , "FAC_YSTO"
- , "FAC_YSRN"
- , "FAC_YKBY"
- , "FAC_YSNY"
- , "FAC_YSRD"
- , "FAC_YBSU"
- , "FAC_YSRT"
- , "FAC_YSWB"
- , "FAC_YSWH"
- , "FAC_YSSY"
- , "FAC_YSBK"
- , "FAC_YTMB"
- , "FAC_YSTW"
- , "FAC_YTMN"
- , "FAC_YTAA"
- , "FAC_YTRE"
- , "FAC_YTAM"
- , "FAC_YTEF"
- , "FAC_YTEM"
- , "FAC_YTNK"
- , "FAC_YTNG"
- , "FAC_YTGM"
- , "FAC_YTGT"
- , "FAC_YLKS"
- , "FAC_YTMO"
- , "FAC_YVAL"
- , "FAC_YTDR"
- , "FAC_YTHY"
- , "FAC_YTIB"
- , "FAC_YTLP"
- , "FAC_YTBR"
- , "FAC_YPTN"
- , "FAC_YTOC"
- , "FAC_YTDN"
- , "FAC_YTKS"
- , "FAC_YTWN"
- , "FAC_YTWB"
- , "FAC_YTQY"
- , "FAC_YTOT"
- , "FAC_YBTL"
- , "FAC_YTEE"
- , "FAC_YTRA"
- , "FAC_YTTI"
- , "FAC_YTFA"
- , "FAC_YTST"
- , "FAC_YTUY"
- , "FAC_YTBB"
- , "FAC_YTMU"
- , "FAC_YTPK"
- , "FAC_YTYA"
- , "FAC_YTYH"
- , "FAC_YUDA"
- , "FAC_YUDG"
- , "FAC_YVRS"
- , "FAC_YVRD"
- , "FAC_YSWG"
- , "FAC_YWHG"
- , "FAC_YWKI"
- , "FAC_YWCH"
- , "FAC_YWLG"
- , "FAC_YWAG"
- , "FAC_YWGT"
- , "FAC_YWBR"
- , "FAC_YWRL"
- , "FAC_YWKW"
- , "FAC_YWVA"
- , "FAC_YWBS"
- , "FAC_YWBI"
- , "FAC_YWKB"
- , "FAC_YWRN"
- , "FAC_YWBL"
- , "FAC_YWCK"
- , "FAC_YWTL"
- , "FAC_YWTB"
- , "FAC_YWSG"
- , "FAC_YWAV"
- , "FAC_YWBN"
- , "FAC_YBWP"
- , "FAC_YWEL"
- , "FAC_YWTO"
- , "FAC_YANG"
- , "FAC_WMD"
- , "FAC_YWSL"
- , "FAC_YWWL"
- , "FAC_YWST"
- , "FAC_YWHC"
- , "FAC_YWHA"
- , "FAC_YWCA"
- , "FAC_YWMC"
- , "FAC_YWIS"
- , "FAC_YWLM"
- , "FAC_YWLU"
- , "FAC_YWDG"
- , "FAC_YWDH"
- , "FAC_YWTN"
- , "FAC_YWVR"
- , "FAC_YWOL"
- , "FAC_YWHP"
- , "FAC_YWND"
- , "FAC_YWDL"
- , "FAC_YWWI"
- , "FAC_YPWR"
- , "FAC_YWMP"
- , "FAC_YWUD"
- , "FAC_YWYA"
- , "FAC_YWYF"
- , "FAC_YWYM"
- , "FAC_YWYY"
- , "FAC_YWYR"
- , "FAC_YYMI"
- , "FAC_YYBK"
- , "FAC_YYRM"
- , "FAC_YYWG"
- , "FAC_YYKI"
- , "FAC_YYNG"
- , "FAC_YYND"
- ]
- ersards =
- [
- "RDS_YPAD"
- , "RDS_YPPF"
- , "RDS_YABA"
- , "RDS_YMAY"
- , "RDS_YBAS"
- , "RDS_YAPH"
- , "RDS_YAMB"
- , "RDS_YARA"
- , "RDS_YARG"
- , "RDS_YARM"
- , "RDS_YAUR"
- , "RDS_YMAV"
- , "RDS_YAYE"
- , "RDS_YBNS"
- , "RDS_YBGO"
- , "RDS_YBLT"
- , "RDS_YLLE"
- , "RDS_YBNA"
- , "RDS_YBRN"
- , "RDS_YBAR"
- , "RDS_YBRY"
- , "RDS_YBWX"
- , "RDS_YBTH"
- , "RDS_YBTI"
- , "RDS_YBIE"
- , "RDS_YBLU"
- , "RDS_YBLA"
- , "RDS_YBDG"
- , "RDS_YBIR"
- , "RDS_YBDV"
- , "RDS_YBCK"
- , "RDS_YBGD"
- , "RDS_YBOU"
- , "RDS_YBKE"
- , "RDS_YBWN"
- , "RDS_YBRW"
- , "RDS_YBWW"
- , "RDS_YBBN"
- , "RDS_YBAF"
- , "RDS_YBHI"
- , "RDS_YBRM"
- , "RDS_YBUN"
- , "RDS_YBUD"
- , "RDS_YBKT"
- , "RDS_YBLN"
- , "RDS_YBCS"
- , "RDS_YSCN"
- , "RDS_YCMW"
- , "RDS_YSCB"
- , "RDS_YCAR"
- , "RDS_YCDU"
- , "RDS_YCNY"
- , "RDS_YCNK"
- , "RDS_YBCV"
- , "RDS_YCHT"
- , "RDS_YCGO"
- , "RDS_YCCA"
- , "RDS_YCHK"
- , "RDS_YPXM"
- , "RDS_YCMT"
- , "RDS_YCEE"
- , "RDS_YCCY"
- , "RDS_YCBA"
- , "RDS_YPCC"
- , "RDS_YCOE"
- , "RDS_YCFS"
- , "RDS_YCDO"
- , "RDS_YCBP"
- , "RDS_YCKN"
- , "RDS_YCAH"
- , "RDS_YCOM"
- , "RDS_YCBB"
- , "RDS_YCNM"
- , "RDS_YCWA"
- , "RDS_YCTM"
- , "RDS_YCOR"
- , "RDS_YCRG"
- , "RDS_YCWR"
- , "RDS_YCKI"
- , "RDS_YCUN"
- , "RDS_YCMU"
- , "RDS_YCIN"
- , "RDS_YDLO"
- , "RDS_YPDN"
- , "RDS_YDGU"
- , "RDS_YDLQ"
- , "RDS_YDBY"
- , "RDS_YDPO"
- , "RDS_YDBI"
- , "RDS_YDOD"
- , "RDS_YDMG"
- , "RDS_YSDU"
- , "RDS_YDKG"
- , "RDS_YEJI"
- , "RDS_YMES"
- , "RDS_YECH"
- , "RDS_YPED"
- , "RDS_YELD"
- , "RDS_YEML"
- , "RDS_YESP"
- , "RDS_YFTZ"
- , "RDS_YFLI"
- , "RDS_YFBS"
- , "RDS_YFRT"
- , "RDS_YFTA"
- , "RDS_YFDF"
- , "RDS_YGPT"
- , "RDS_YGAY"
- , "RDS_YGTN"
- , "RDS_YGEL"
- , "RDS_YGIA"
- , "RDS_YGIG"
- , "RDS_YGLA"
- , "RDS_YGLI"
- , "RDS_YBCG"
- , "RDS_YGGE"
- , "RDS_YGDA"
- , "RDS_YGDI"
- , "RDS_YGLB"
- , "RDS_YPGV"
- , "RDS_YGFN"
- , "RDS_YGRS"
- , "RDS_YGTH"
- , "RDS_YGTE"
- , "RDS_YGDH"
- , "RDS_YHLC"
- , "RDS_YHML"
- , "RDS_YBHM"
- , "RDS_YHAY"
- , "RDS_YHBA"
- , "RDS_YMHB"
- , "RDS_YHPN"
- , "RDS_YHID"
- , "RDS_YHSM"
- , "RDS_YHUG"
- , "RDS_YIFL"
- , "RDS_YIVL"
- , "RDS_YJAB"
- , "RDS_YJAC"
- , "RDS_YJLC"
- , "RDS_YJUN"
- , "RDS_YKBR"
- , "RDS_YPKG"
- , "RDS_YKKG"
- , "RDS_YKAL"
- , "RDS_YKAR"
- , "RDS_YPKA"
- , "RDS_YKMB"
- , "RDS_YKNG"
- , "RDS_YKMP"
- , "RDS_YKER"
- , "RDS_YIMB"
- , "RDS_YKII"
- , "RDS_YKRY"
- , "RDS_YKSC"
- , "RDS_YKOW"
- , "RDS_YPKU"
- , "RDS_YLCG"
- , "RDS_YLEV"
- , "RDS_YLTV"
- , "RDS_YMLT"
- , "RDS_YLTN"
- , "RDS_YPLM"
- , "RDS_YLEC"
- , "RDS_YLST"
- , "RDS_YLEO"
- , "RDS_YLRD"
- , "RDS_YLIS"
- , "RDS_YLHR"
- , "RDS_YLRE"
- , "RDS_YLHI"
- , "RDS_YLOX"
- , "RDS_YBMK"
- , "RDS_YMND"
- , "RDS_YMCO"
- , "RDS_YMNG"
- , "RDS_YMGD"
- , "RDS_YMJM"
- , "RDS_YMBA"
- , "RDS_YMYB"
- , "RDS_YMBU"
- , "RDS_YMHU"
- , "RDS_YMEK"
- , "RDS_YMML"
- , "RDS_YMEN"
- , "RDS_YMMB"
- , "RDS_YMER"
- , "RDS_YMMU"
- , "RDS_YMIA"
- , "RDS_YMLS"
- , "RDS_YMGB"
- , "RDS_YOOM"
- , "RDS_YMRB"
- , "RDS_YMRW"
- , "RDS_YMOR"
- , "RDS_YMTI"
- , "RDS_YMRY"
- , "RDS_YMTG"
- , "RDS_YGON"
- , "RDS_YHOT"
- , "RDS_YBMA"
- , "RDS_YMNE"
- , "RDS_YMOG"
- , "RDS_YMDG"
- , "RDS_YMUL"
- , "RDS_YMMI"
- , "RDS_YNRC"
- , "RDS_YNBR"
- , "RDS_YNAR"
- , "RDS_YNRM"
- , "RDS_YNWN"
- , "RDS_YNGU"
- , "RDS_YNHL"
- , "RDS_YCNF"
- , "RDS_YSNF"
- , "RDS_YNTN"
- , "RDS_YNSM"
- , "RDS_YNPE"
- , "RDS_YNOV"
- , "RDS_YSNW"
- , "RDS_YNUM"
- , "RDS_YNYN"
- , "RDS_YBOK"
- , "RDS_YOEN"
- , "RDS_YOLD"
- , "RDS_YOLW"
- , "RDS_YORG"
- , "RDS_YORB"
- , "RDS_YOSB"
- , "RDS_YPAM"
- , "RDS_YPBO"
- , "RDS_YPKS"
- , "RDS_YPEA"
- , "RDS_YPPH"
- , "RDS_YPJT"
- , "RDS_YPLU"
- , "RDS_YMPC"
- , "RDS_YPCE"
- , "RDS_YPMP"
- , "RDS_YPAG"
- , "RDS_YPPD"
- , "RDS_YPKT"
- , "RDS_YPLC"
- , "RDS_YPMQ"
- , "RDS_YPIR"
- , "RDS_YPOD"
- , "RDS_YPMH"
- , "RDS_YBPN"
- , "RDS_YQLP"
- , "RDS_YQDI"
- , "RDS_YRNG"
- , "RDS_YNRV"
- , "RDS_YREN"
- , "RDS_YSRI"
- , "RDS_YRMD"
- , "RDS_YROI"
- , "RDS_YBRK"
- , "RDS_YROM"
- , "RDS_YRTI"
- , "RDS_YSII"
- , "RDS_YSTA"
- , "RDS_YSGE"
- , "RDS_YSTH"
- , "RDS_YBSG"
- , "RDS_YSCO"
- , "RDS_YSLK"
- , "RDS_YSHK"
- , "RDS_YSHT"
- , "RDS_YSNB"
- , "RDS_YSOL"
- , "RDS_YGBI"
- , "RDS_YSCR"
- , "RDS_YSPT"
- , "RDS_YSPE"
- , "RDS_YSWL"
- , "RDS_YSRN"
- , "RDS_YKBY"
- , "RDS_YSRD"
- , "RDS_YBSU"
- , "RDS_YSWH"
- , "RDS_YSSY"
- , "RDS_YSBK"
- , "RDS_YSTW"
- , "RDS_YTRE"
- , "RDS_YTAM"
- , "RDS_YTEF"
- , "RDS_YTEM"
- , "RDS_YTNK"
- , "RDS_YTNG"
- , "RDS_YTGM"
- , "RDS_YTGT"
- , "RDS_YTMO"
- , "RDS_YTIB"
- , "RDS_YPTN"
- , "RDS_YTOC"
- , "RDS_YTWB"
- , "RDS_YBTL"
- , "RDS_YTEE"
- , "RDS_YTRA"
- , "RDS_YTTI"
- , "RDS_YTST"
- , "RDS_YTBB"
- , "RDS_YTMU"
- , "RDS_YSWG"
- , "RDS_YWKI"
- , "RDS_YWLG"
- , "RDS_YWGT"
- , "RDS_YWBR"
- , "RDS_YWKB"
- , "RDS_YWRN"
- , "RDS_YWBL"
- , "RDS_YWCK"
- , "RDS_YBWP"
- , "RDS_YWTO"
- , "RDS_YANG"
- , "RDS_YWSL"
- , "RDS_YWWL"
- , "RDS_YWHA"
- , "RDS_YWLM"
- , "RDS_YWLU"
- , "RDS_YWDG"
- , "RDS_YWDH"
- , "RDS_YWTN"
- , "RDS_YWOL"
- , "RDS_YPWR"
- , "RDS_YWUD"
- , "RDS_YWYF"
- , "RDS_YWYM"
- , "RDS_YWYY"
- , "RDS_YYRM"
- , "RDS_YYWG"
- , "RDS_YYKI"
- , "RDS_YYNG"
- ]
- allersa =
- (ersaprelim ++ ersafac ++ ersards) >>= \f ->
- ["current", "pending"] >>= \q ->
- ersas >>= \(Ersa _ d) ->
- let req = concat [q, "/ersa/", f, "_", uriAipDate d, ".pdf"]
- in pure (AipDocument (aipRequestGet req "") (dir </> req))
- allSimpleAipDocuments =
- simpleAipDocuments >>= \x ->
- ["current", "pending"] >>= \q ->
- let req = concat [q, "/", x]
- in pure (AipDocument (aipRequestGet req "") (dir </> req))
- in AipDocuments
- (allSimpleAipDocuments ++ allersa)
+instance (AipDocuments book charts sup_aic dap ersa) ~ x =>
+ Rewrapped (AipDocuments book charts sup_aic dap ersa) x
+
+type AipDocuments1 =
+ AipDocuments () () () () ()
+
+type AipDocuments2 =
+ AipDocuments ListItemLinks ListItemLinks1 Aip_SUP_and_AICs DAPDocs Ersa
+
+instance (FromJSON book, FromJSON charts, FromJSON sup_aic, FromJSON dap, FromJSON ersa) => FromJSON (AipDocuments book charts sup_aic dap ersa) where
+ parseJSON =
+ withArray "AipDocuments" $ \v ->
+ AipDocuments <$> traverse parseJSON (toList v)
+
+instance (ToJSON book, ToJSON charts, ToJSON sup_aic, ToJSON dap, ToJSON ersa) => ToJSON (AipDocuments book charts sup_aic dap ersa) where
+ toJSON (AipDocuments x) =
+ toJSON x
+
+instance Cons (AipDocuments book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc (AipDocuments book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each (AipDocuments book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) (AipDocument book charts sup_aic dap ersa) where
+ each =
+ _Wrapped . each
+
+instance Reversing (AipDocuments book charts sup_aic dap ersa) where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated (AipDocuments book charts sup_aic dap ersa) where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue (AipDocuments book charts sup_aic dap ersa) = (AipDocument book charts sup_aic dap ersa)
+type instance Index (AipDocuments book charts sup_aic dap ersa) = Int
+instance Ixed (AipDocuments book charts sup_aic dap ersa) where
+ ix i =
+ _Wrapped . ix i
+
+class ManyAipDocuments a => AsAipDocuments a where
+ _AipDocuments ::
+ Prism (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ default _AipDocuments ::
+ IsAipDocuments a =>
+ Prism (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ _AipDocuments =
+ _IsAipDocuments
+
+instance AsAipDocuments AipDocuments where
+ _AipDocuments =
+ id
+
+class FoldAipDocuments a where
+ _FoldAipDocuments ::
+ Fold (a book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa)
+
+instance FoldAipDocuments AipDocuments where
+ _FoldAipDocuments =
+ id
+
+class FoldAipDocuments a => GetAipDocuments a where
+ _GetAipDocuments ::
+ Getter (a book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa)
+ default _GetAipDocuments ::
+ HasAipDocuments a =>
+ Getter (a book charts sup_aic dap ersa) (AipDocuments book charts sup_aic dap ersa)
+ _GetAipDocuments =
+ aipDocuments
+
+instance GetAipDocuments AipDocuments where
+ _GetAipDocuments =
+ id
+
+class SetAipDocuments a where
+ _SetAipDocuments ::
+ Setter (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ default _SetAipDocuments ::
+ ManyAipDocuments a =>
+ Setter (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ _SetAipDocuments =
+ _ManyAipDocuments
+
+instance SetAipDocuments AipDocuments where
+ _SetAipDocuments =
+ id
+
+class (FoldAipDocuments a, SetAipDocuments a) => ManyAipDocuments a where
+ _ManyAipDocuments ::
+ Traversal (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+
+instance ManyAipDocuments AipDocuments where
+ _ManyAipDocuments =
+ id
+
+class (GetAipDocuments a, ManyAipDocuments a) => HasAipDocuments a where
+ aipDocuments ::
+ Lens (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ default aipDocuments ::
+ IsAipDocuments a =>
+ Lens (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+ aipDocuments =
+ _IsAipDocuments
+
+instance HasAipDocuments AipDocuments where
+ aipDocuments =
+ id
+
+class (HasAipDocuments a, AsAipDocuments a) => IsAipDocuments a where
+ _IsAipDocuments ::
+ Iso (a book charts sup_aic dap ersa) (a book' charts' sup_aic' dap' ersa') (AipDocuments book charts sup_aic dap ersa) (AipDocuments book' charts' sup_aic' dap' ersa')
+
+instance IsAipDocuments AipDocuments where
+ _IsAipDocuments =
+ id
+
+----
+
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => SetHref (AipDocuments book charts sup_aic dap ersa) where
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => FoldHref (AipDocuments book charts sup_aic dap ersa) where
+ _FoldHref =
+ _ManyHref
+
+instance (ManyHref book, ManyHref charts, ManyHref sup_aic, ManyHref dap, ManyHref ersa) => ManyHref (AipDocuments book charts sup_aic dap ersa) where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/AipHref.hs b/src/Data/Aviation/Aip/AipHref.hs
deleted file mode 100644
index 1ea9a0c..0000000
--- a/src/Data/Aviation/Aip/AipHref.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Data.Aviation.Aip.AipHref(
- AipHref(..)
-, parseAipHref
-, uriAipHref
-, HasAipHref(..)
-) where
-
-import Data.Aviation.Aip.AipDate(AipDate, HasAipDate(aipDate), parseAipDate)
-import Data.Aviation.Aip.AipPg(AipPg, HasAipPg(aipPg), parseAipPg, aippg1, aippg2)
-import Data.Aviation.Aip.Day(HasDay(day, day1, day2))
-import Data.Aviation.Aip.Month(HasMonth(month))
-import Data.Aviation.Aip.Year(HasYear(year, year1, year2, year3, year4))
-import Data.Digit(Digit, HasDigit(hasdigit), parsedigit)
-import Text.Parser.Char(CharParsing, string)
-import Papa
-
-data AipHref =
- AipHref {
- _aiphrefpg ::
- AipPg
- , _aiphrefdate ::
- AipDate
- , _aiphrefversion ::
- Digit
- } deriving (Eq, Ord, Show)
-
-makeClassy ''AipHref
-
-parseAipHref ::
- (CharParsing p, Monad p) =>
- p AipHref
-parseAipHref =
- string "aip.asp?pg=" *>
- (AipHref <$> parseAipPg <* string "&vdate=" <*> parseAipDate <* string "&ver=" <*> parsedigit)
-
-uriAipHref ::
- HasAipHref s =>
- s
- -> String
-uriAipHref ahref =
- concat
- [
- "?pg="
- , show (ahref ^. aipHref . aippg1)
- , show (ahref ^. aipHref . aippg2)
- , "&vdate="
- , show (ahref ^. aipHref . day1)
- , show (ahref ^. aipHref . day2)
- , "-"
- , show (ahref ^. aipHref . month)
- , "-"
- , show (ahref ^. aipHref . year1)
- , show (ahref ^. aipHref . year2)
- , show (ahref ^. aipHref . year3)
- , show (ahref ^. aipHref . year4)
- , "&ver="
- , show (ahref ^. aipHref . hasdigit)
- ]
-
-instance HasAipPg AipHref where
- aipPg =
- aiphrefpg . aipPg
-
-instance HasAipDate AipHref where
- aipDate =
- aiphrefdate . aipDate
-
-instance HasDigit AipHref where
- hasdigit =
- aiphrefversion . hasdigit
-
-instance HasDay AipHref where
- day =
- aipDate . day
-
-instance HasMonth AipHref where
- month =
- aipDate . month
-
-instance HasYear AipHref where
- year =
- aipDate . year
- \ No newline at end of file
diff --git a/src/Data/Aviation/Aip/AipOptions.hs b/src/Data/Aviation/Aip/AipOptions.hs
new file mode 100644
index 0000000..97f14ad
--- /dev/null
+++ b/src/Data/Aviation/Aip/AipOptions.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Data.Aviation.Aip.AipOptions(
+ AipOptions(..)
+, aipOptionOutputDirectory
+, aipOptionCache
+, aipOptionLog
+, aipOptionVerbose
+, parserAipOptions
+) where
+
+import Control.Applicative((<*>))
+import Control.Lens
+import Data.Aviation.Aip.Cache(Cache(ReadCache, ReadWriteCache, NoCache))
+import Data.Bool(Bool)
+import Data.Eq(Eq)
+import Data.Functor(fmap, (<$>))
+import Data.Maybe(Maybe(Just, Nothing))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Options.Applicative(Parser, argument, str, help, metavar, option, maybeReader, short, long, value, switch)
+import Prelude(Show)
+import System.FilePath(FilePath)
+
+data AipOptions =
+ AipOptions
+ 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)
+
+aipOptionCache ::
+ Lens' AipOptions Cache
+aipOptionCache k (AipOptions d c l v) =
+ fmap (\c' -> AipOptions d c' l v) (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)
+
+parserAipOptions ::
+ Parser AipOptions
+parserAipOptions =
+ AipOptions
+ <$>
+ Options.Applicative.argument
+ str
+ (
+ help "AIP output directory" <>
+ metavar "aip-output-directory"
+ )
+ <*>
+ option
+ (
+ maybeReader
+ (\s -> case s of
+ "r" -> Just ReadCache
+ "rw" -> Just ReadWriteCache
+ "no" -> Just NoCache
+ _ -> Nothing
+ )
+ )
+ (
+ short 'c' <>
+ long "cache" <>
+ value ReadWriteCache <>
+ help "how to utilise the cache to build the AIP document tree"
+ )
+ <*>
+ switch
+ (
+ long "log" <>
+ short 'l' <>
+ help "log to standard output"
+ )
+ <*>
+ switch
+ (
+ long "verbose" <>
+ short 'v' <>
+ help "print the AIP document tree after download"
+ )
diff --git a/src/Data/Aviation/Aip/AipPg.hs b/src/Data/Aviation/Aip/AipPg.hs
deleted file mode 100644
index 303570a..0000000
--- a/src/Data/Aviation/Aip/AipPg.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Data.Aviation.Aip.AipPg where
-
-import Data.Digit(Digit, parsedigit)
-import Text.Parser.Char(CharParsing, string)
-import Papa
-
-data AipPg =
- AipPg {
- _aippg1 ::
- Digit
- , _aippg2 ::
- Digit
- } deriving (Eq, Ord, Show)
-
-makeClassy ''AipPg
-
-parseAipPg ::
- (CharParsing p, Monad p) =>
- p AipPg
-parseAipPg =
- AipPg <$> parsedigit <*> parsedigit
-
-parseAipPgHref ::
- (CharParsing p, Monad p) =>
- p AipPg
-parseAipPgHref =
- string "aip.asp?pg=" *>
- parseAipPg
diff --git a/src/Data/Aviation/Aip/AipRecord.hs b/src/Data/Aviation/Aip/AipRecord.hs
new file mode 100644
index 0000000..bc6c62c
--- /dev/null
+++ b/src/Data/Aviation/Aip/AipRecord.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.AipRecord(
+ AipRecord(..)
+, AsAipRecord(..)
+, FoldAipRecord(..)
+, GetAipRecord(..)
+, SetAipRecord(..)
+, ManyAipRecord(..)
+, HasAipRecord(..)
+, IsAipRecord(..)
+, aipRecordAipDocuments
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+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.Eq(Eq)
+import Data.Function(($))
+import Data.Functor(fmap, (<$>))
+import Data.Time(UTCTime)
+import Prelude(Show)
+
+data AipRecord =
+ AipRecord
+ UTCTime
+ AipDocuments2
+ deriving (Eq, Show)
+
+instance FromJSON AipRecord where
+ parseJSON =
+ withObject "AipRecord" $ \v ->
+ AipRecord <$>
+ v .: "utc" <*>
+ v .: "documents"
+
+instance ToJSON AipRecord where
+ toJSON (AipRecord t p) =
+ object ["utc" .= t, "documents" .= p]
+
+class ManyAipRecord a => AsAipRecord a where
+ _AipRecord ::
+ Prism' a AipRecord
+ default _AipRecord ::
+ IsAipRecord a =>
+ Prism' a AipRecord
+ _AipRecord =
+ _IsAipRecord
+
+instance AsAipRecord AipRecord where
+ _AipRecord =
+ id
+
+class FoldAipRecord a where
+ _FoldAipRecord ::
+ Fold a AipRecord
+
+instance FoldAipRecord AipRecord where
+ _FoldAipRecord =
+ id
+
+class FoldAipRecord a => GetAipRecord a where
+ _GetAipRecord ::
+ Getter a AipRecord
+ default _GetAipRecord ::
+ HasAipRecord a =>
+ Getter a AipRecord
+ _GetAipRecord =
+ aipRecord
+
+instance GetAipRecord AipRecord where
+ _GetAipRecord =
+ id
+
+class SetAipRecord a where
+ _SetAipRecord ::
+ Setter' a AipRecord
+ default _SetAipRecord ::
+ ManyAipRecord a =>
+ Setter' a AipRecord
+ _SetAipRecord =
+ _ManyAipRecord
+
+instance SetAipRecord AipRecord where
+ _SetAipRecord =
+ id
+
+class (FoldAipRecord a, SetAipRecord a) => ManyAipRecord a where
+ _ManyAipRecord ::
+ Traversal' a AipRecord
+
+instance ManyAipRecord AipRecord where
+ _ManyAipRecord =
+ id
+
+class (GetAipRecord a, ManyAipRecord a) => HasAipRecord a where
+ aipRecord ::
+ Lens' a AipRecord
+ default aipRecord ::
+ IsAipRecord a =>
+ Lens' a AipRecord
+ aipRecord =
+ _IsAipRecord
+
+instance HasAipRecord AipRecord where
+ aipRecord =
+ id
+
+class (HasAipRecord a, AsAipRecord a) => IsAipRecord a where
+ _IsAipRecord ::
+ Iso' a AipRecord
+
+instance IsAipRecord AipRecord where
+ _IsAipRecord =
+ id
+
+instance SetAipRecord () where
+instance FoldAipRecord () where
+ _FoldAipRecord =
+ _ManyAipRecord
+instance ManyAipRecord () where
+ _ManyAipRecord _ x =
+ pure x
+
+----
+
+instance SetHref AipRecord where
+instance FoldHref AipRecord where
+ _FoldHref =
+ _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)
+
diff --git a/src/Data/Aviation/Aip/AipRecords.hs b/src/Data/Aviation/Aip/AipRecords.hs
new file mode 100644
index 0000000..0d1824e
--- /dev/null
+++ b/src/Data/Aviation/Aip/AipRecords.hs
@@ -0,0 +1,339 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.AipRecords(
+ AipRecords(..)
+, AsAipRecords(..)
+, FoldAipRecords(..)
+, GetAipRecords(..)
+, SetAipRecords(..)
+, ManyAipRecords(..)
+, HasAipRecords(..)
+, IsAipRecords(..)
+, getAipRecords
+, aipRecords1
+, run
+) where
+
+import Control.Category((.), id)
+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.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.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.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(($))
+import Data.Functor(fmap, (<$>))
+import Data.List(dropWhile, splitAt)
+import Data.List.NonEmpty(NonEmpty((:|)))
+import Data.Maybe(Maybe(Just, Nothing))
+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.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)
+
+data AipRecords =
+ AipRecords
+ SHA1
+ (NonEmpty AipRecord)
+ deriving (Eq, Show)
+
+instance FromJSON AipRecords where
+ parseJSON =
+ withObject "AipRecords" $ \v ->
+ AipRecords <$>
+ v .: "sha1" <*>
+ v .: "aiprecords"
+
+instance ToJSON AipRecords where
+ toJSON (AipRecords s r) =
+ object ["sha1" .= s, "aiprecords" .= r]
+
+class ManyAipRecords a => AsAipRecords a where
+ _AipRecords ::
+ Prism' a AipRecords
+ default _AipRecords ::
+ IsAipRecords a =>
+ Prism' a AipRecords
+ _AipRecords =
+ _IsAipRecords
+
+instance AsAipRecords AipRecords where
+ _AipRecords =
+ id
+
+class FoldAipRecords a where
+ _FoldAipRecords ::
+ Fold a AipRecords
+
+instance FoldAipRecords AipRecords where
+ _FoldAipRecords =
+ id
+
+class FoldAipRecords a => GetAipRecords a where
+ _GetAipRecords ::
+ Getter a AipRecords
+ default _GetAipRecords ::
+ HasAipRecords a =>
+ Getter a AipRecords
+ _GetAipRecords =
+ aipRecords
+
+instance GetAipRecords AipRecords where
+ _GetAipRecords =
+ id
+
+class SetAipRecords a where
+ _SetAipRecords ::
+ Setter' a AipRecords
+ default _SetAipRecords ::
+ ManyAipRecords a =>
+ Setter' a AipRecords
+ _SetAipRecords =
+ _ManyAipRecords
+
+instance SetAipRecords AipRecords where
+ _SetAipRecords =
+ id
+
+class (FoldAipRecords a, SetAipRecords a) => ManyAipRecords a where
+ _ManyAipRecords ::
+ Traversal' a AipRecords
+
+instance ManyAipRecords AipRecords where
+ _ManyAipRecords =
+ id
+
+class (GetAipRecords a, ManyAipRecords a) => HasAipRecords a where
+ aipRecords ::
+ Lens' a AipRecords
+ default aipRecords ::
+ IsAipRecords a =>
+ Lens' a AipRecords
+ aipRecords =
+ _IsAipRecords
+
+instance HasAipRecords AipRecords where
+ aipRecords =
+ id
+
+class (HasAipRecords a, AsAipRecords a) => IsAipRecords a where
+ _IsAipRecords ::
+ Iso' a AipRecords
+
+instance IsAipRecords AipRecords where
+ _IsAipRecords =
+ id
+
+instance SetAipRecords () where
+instance FoldAipRecords () where
+ _FoldAipRecords =
+ _ManyAipRecords
+instance ManyAipRecords () where
+ _ManyAipRecords _ x =
+ pure x
+
+getAipRecords ::
+ Cache
+ -> FilePath -- basedir
+ -> AipCon AipRecords
+getAipRecords cch dir =
+ let readCache ::
+ FilePath
+ -> AipCon (Maybe AipRecords)
+ readCache c =
+ if isReadOrWriteCache cch
+ then
+ do e <- liftIO $ doesFileExist c
+ if e
+ then
+ do p <- liftIO $ getPermissions c
+ if readable p
+ then
+ do aiplog "reading aip contents cache"
+ liftIO $ decodeFileStrict c :: AipCon (Maybe (AipRecords))
+ else
+ do aiplog "aip contents cache no read permission"
+ pure Nothing
+ else
+ do aiplog "aip contents cache not exists"
+ pure Nothing
+ else
+ do aiplog "configured for no read aip contents cache"
+ pure Nothing
+
+ writeCache z rs =
+ when (isWriteCache cch) $
+ do aiplog "writing aip contents cache"
+ liftIO $ createDirectoryIfMissing True (takeDirectory z)
+ let conf = defConfig { confIndent = Spaces 2 }
+ liftIO $ LazyByteString.writeFile z (encodePretty' conf rs)
+ trimSpaces =
+ dropWhile isSpace
+ in do c <- requestAipContents
+ let h = hash (UTF8.encode c)
+ let h' = hashHex h
+ aiplog ("aip contents, sha1: " <> h' "")
+ let z = dir </> h' ".json"
+ r <- readCache z
+ case r of
+ Just v ->
+ do aiplog "using and returning aip contents cache"
+ pure v
+ Nothing ->
+ let traverseAipDocuments ::
+ TagTreePos String
+ -> AipDocuments1
+ traverseAipDocuments (TagTreePos (TagBranch "ul" [] x) _ _ _) =
+ let li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "AIP Book")], TagLeaf (TagText tx)]) =
+ [Aip_Book (Href hf) (AipDate (trimSpaces tx)) ()]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "AIP Charts")], TagLeaf (TagText tx)]) =
+ [Aip_Charts (Href hf) (AipDate (trimSpaces tx)) ()]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "AIP Supplements and Aeronautical Information Circulars (AIC)")]]) =
+ [Aip_SUP_AIC (Href hf) ()]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "Departure and Approach Procedures (DAP)")], TagLeaf (TagText tx)]) =
+ [Aip_DAP (Href hf) (AipDate (trimSpaces tx)) ()]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "Designated Airspace Handbook (DAH)")], TagLeaf (TagText tx)]) =
+ [Aip_DAH (Href hf) (AipDate (trimSpaces tx))]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "En Route Supplement Australia (ERSA)")], TagLeaf (TagText tx)]) =
+ [Aip_ERSA (Href hf) (AipDate (trimSpaces tx)) ()]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText "Precision Approach Terrain Charts and Type A & Type B Obstacle Charts")]]) =
+ [Aip_AandB_Charts (Href hf)]
+ li (TagBranch "li" [] [TagBranch "a" [("href", hf)] [TagLeaf (TagText tx)]]) =
+ let st = "Summary of SUP/AIC Current"
+ (p, s) = splitAt (length st) tx
+ in if p == st then
+ [Aip_Summary_SUP_AIC (Href hf) (AipDate (trimSpaces s))]
+ else
+ []
+ li _ =
+ []
+ in AipDocuments (x >>= li)
+ traverseAipDocuments _ =
+ mempty
+ in do let AipDocuments a = foldMap (traverseTree traverseAipDocuments . fromTagTree) (parseTree c)
+ q <- AipDocuments <$> traverse runAipDocument a
+ t <- liftIO getCurrentTime
+ aiplog ("traverse aip records at time " <> show t)
+ let rs = AipRecords h (AipRecord t q :| [])
+ writeCache z rs
+ pure rs
+
+----
+
+instance FoldAipRecord AipRecords where
+ _FoldAipRecord =
+ _ManyAipRecord
+
+instance SetAipRecord AipRecords where
+
+instance ManyAipRecord AipRecords where
+ _ManyAipRecord f (AipRecords s r) =
+ AipRecords s <$> traverse f r
+
+instance SetHref AipRecords where
+instance FoldHref AipRecords where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref AipRecords where
+ _ManyHref f (AipRecords s r) =
+ AipRecords <$> pure s <*> (traverse . _ManyHref) f r
+
+instance FoldSHA1 AipRecords where
+ _FoldSHA1 =
+ sha1
+
+instance GetSHA1 AipRecords where
+
+instance ManySHA1 AipRecords where
+ _ManySHA1 =
+ sha1
+
+instance SetSHA1 AipRecords where
+
+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))
diff --git a/src/Data/Aviation/Aip/Aip_SUP_and_AIC.hs b/src/Data/Aviation/Aip/Aip_SUP_and_AIC.hs
new file mode 100644
index 0000000..c17c872
--- /dev/null
+++ b/src/Data/Aviation/Aip/Aip_SUP_and_AIC.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Aip_SUP_and_AIC(
+ Aip_SUP_and_AIC(..)
+, AsAip_SUP_and_AIC(..)
+, FoldAip_SUP_and_AIC(..)
+, GetAip_SUP_and_AIC(..)
+, SetAip_SUP_and_AIC(..)
+, ManyAip_SUP_and_AIC(..)
+, HasAip_SUP_and_AIC(..)
+, IsAip_SUP_and_AIC(..)
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Aviation.Aip.AipDate(AipDate)
+import Data.Aviation.Aip.DocumentNumber(DocumentNumber)
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref), GetHref, HasHref(href))
+import Data.Aviation.Aip.Title(Title)
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor(fmap, (<$>))
+import Data.Ord(Ord)
+import Prelude(Show)
+
+data Aip_SUP_and_AIC =
+ Aip_SUP_and_AIC
+ DocumentNumber
+ Href
+ Title
+ AipDate
+ AipDate
+ deriving (Eq, Ord, Show)
+
+instance FromJSON Aip_SUP_and_AIC where
+ parseJSON =
+ withObject "Aip_SUP_and_AIC" $ \v ->
+ Aip_SUP_and_AIC <$>
+ v .: "docnum" <*>
+ v .: "href" <*>
+ v .: "title" <*>
+ v .: "pubdate" <*>
+ v .: "effdate"
+
+instance ToJSON Aip_SUP_and_AIC where
+ toJSON (Aip_SUP_and_AIC docnum u title pubdate effdate) =
+ object ["docnum" .= docnum, "href" .= u, "title" .= title, "pubdate" .= pubdate, "effdate" .= effdate]
+
+class ManyAip_SUP_and_AIC a => AsAip_SUP_and_AIC a where
+ _Aip_SUP_and_AIC ::
+ Prism' a Aip_SUP_and_AIC
+ default _Aip_SUP_and_AIC ::
+ IsAip_SUP_and_AIC a =>
+ Prism' a Aip_SUP_and_AIC
+ _Aip_SUP_and_AIC =
+ _IsAip_SUP_and_AIC
+
+instance AsAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _Aip_SUP_and_AIC =
+ id
+
+class FoldAip_SUP_and_AIC a where
+ _FoldAip_SUP_and_AIC ::
+ Fold a Aip_SUP_and_AIC
+
+instance FoldAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _FoldAip_SUP_and_AIC =
+ id
+
+class FoldAip_SUP_and_AIC a => GetAip_SUP_and_AIC a where
+ _GetAip_SUP_and_AIC ::
+ Getter a Aip_SUP_and_AIC
+ default _GetAip_SUP_and_AIC ::
+ HasAip_SUP_and_AIC a =>
+ Getter a Aip_SUP_and_AIC
+ _GetAip_SUP_and_AIC =
+ aip_SUP_and_AIC
+
+instance GetAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _GetAip_SUP_and_AIC =
+ id
+
+class SetAip_SUP_and_AIC a where
+ _SetAip_SUP_and_AIC ::
+ Setter' a Aip_SUP_and_AIC
+ default _SetAip_SUP_and_AIC ::
+ ManyAip_SUP_and_AIC a =>
+ Setter' a Aip_SUP_and_AIC
+ _SetAip_SUP_and_AIC =
+ _ManyAip_SUP_and_AIC
+
+instance SetAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _SetAip_SUP_and_AIC =
+ id
+
+class (FoldAip_SUP_and_AIC a, SetAip_SUP_and_AIC a) => ManyAip_SUP_and_AIC a where
+ _ManyAip_SUP_and_AIC ::
+ Traversal' a Aip_SUP_and_AIC
+
+instance ManyAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _ManyAip_SUP_and_AIC =
+ id
+
+class (GetAip_SUP_and_AIC a, ManyAip_SUP_and_AIC a) => HasAip_SUP_and_AIC a where
+ aip_SUP_and_AIC ::
+ Lens' a Aip_SUP_and_AIC
+ default aip_SUP_and_AIC ::
+ IsAip_SUP_and_AIC a =>
+ Lens' a Aip_SUP_and_AIC
+ aip_SUP_and_AIC =
+ _IsAip_SUP_and_AIC
+
+instance HasAip_SUP_and_AIC Aip_SUP_and_AIC where
+ aip_SUP_and_AIC =
+ id
+
+class (HasAip_SUP_and_AIC a, AsAip_SUP_and_AIC a) => IsAip_SUP_and_AIC a where
+ _IsAip_SUP_and_AIC ::
+ Iso' a Aip_SUP_and_AIC
+
+instance IsAip_SUP_and_AIC Aip_SUP_and_AIC where
+ _IsAip_SUP_and_AIC =
+ id
+
+instance SetAip_SUP_and_AIC () where
+instance FoldAip_SUP_and_AIC () where
+ _FoldAip_SUP_and_AIC =
+ _ManyAip_SUP_and_AIC
+instance ManyAip_SUP_and_AIC () where
+ _ManyAip_SUP_and_AIC _ x =
+ pure x
+
+----
+
+instance SetHref Aip_SUP_and_AIC where
+instance FoldHref Aip_SUP_and_AIC where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref Aip_SUP_and_AIC where
+ _ManyHref f (Aip_SUP_and_AIC docnum u title pubdate effdate) =
+ Aip_SUP_and_AIC <$> pure docnum <*> f u <*> pure title <*> pure pubdate <*> pure effdate
+
+instance GetHref Aip_SUP_and_AIC where
+instance HasHref Aip_SUP_and_AIC where
+ href f (Aip_SUP_and_AIC docnum u title pubdate effdate) =
+ fmap (\u' -> Aip_SUP_and_AIC docnum u' title pubdate effdate) (f u)
diff --git a/src/Data/Aviation/Aip/Aip_SUP_and_AICs.hs b/src/Data/Aviation/Aip/Aip_SUP_and_AICs.hs
new file mode 100644
index 0000000..fd22902
--- /dev/null
+++ b/src/Data/Aviation/Aip/Aip_SUP_and_AICs.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Aviation.Aip.Aip_SUP_and_AICs(
+ Aip_SUP_and_AICs(..)
+, AsAip_SUP_and_AICs(..)
+, FoldAip_SUP_and_AICs(..)
+, GetAip_SUP_and_AICs(..)
+, SetAip_SUP_and_AICs(..)
+, ManyAip_SUP_and_AICs(..)
+, HasAip_SUP_and_AICs(..)
+, IsAip_SUP_and_AICs(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Aviation.Aip.Aip_SUP_and_AIC(Aip_SUP_and_AIC)
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+
+newtype Aip_SUP_and_AICs =
+ Aip_SUP_and_AICs
+ [Aip_SUP_and_AIC]
+ deriving (Eq, Ord, Show)
+
+instance Semigroup Aip_SUP_and_AICs where
+ Aip_SUP_and_AICs x <> Aip_SUP_and_AICs y =
+ Aip_SUP_and_AICs (x <> y)
+
+instance Monoid Aip_SUP_and_AICs where
+ mappend =
+ (<>)
+ mempty =
+ Aip_SUP_and_AICs mempty
+
+instance FromJSON Aip_SUP_and_AICs where
+ parseJSON =
+ withArray "Aip_SUP_and_AICs" $ \v ->
+ Aip_SUP_and_AICs <$> traverse parseJSON (toList v)
+
+instance ToJSON Aip_SUP_and_AICs where
+ toJSON (Aip_SUP_and_AICs x) =
+ toJSON x
+
+instance Wrapped Aip_SUP_and_AICs where
+ type Unwrapped Aip_SUP_and_AICs =
+ [Aip_SUP_and_AIC]
+ _Wrapped' =
+ iso (\(Aip_SUP_and_AICs x) -> x) Aip_SUP_and_AICs
+
+instance Aip_SUP_and_AICs ~ x =>
+ Rewrapped Aip_SUP_and_AICs x
+
+instance Cons Aip_SUP_and_AICs Aip_SUP_and_AICs Aip_SUP_and_AIC Aip_SUP_and_AIC where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc Aip_SUP_and_AICs Aip_SUP_and_AICs Aip_SUP_and_AIC Aip_SUP_and_AIC where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each Aip_SUP_and_AICs Aip_SUP_and_AICs Aip_SUP_and_AIC Aip_SUP_and_AIC where
+ each =
+ _Wrapped . each
+
+instance Reversing Aip_SUP_and_AICs where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated Aip_SUP_and_AICs where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue Aip_SUP_and_AICs = Aip_SUP_and_AIC
+type instance Index Aip_SUP_and_AICs = Int
+instance Ixed Aip_SUP_and_AICs where
+ ix i =
+ _Wrapped . ix i
+
+class ManyAip_SUP_and_AICs a => AsAip_SUP_and_AICs a where
+ _Aip_SUP_and_AICs ::
+ Prism' a Aip_SUP_and_AICs
+ default _Aip_SUP_and_AICs ::
+ IsAip_SUP_and_AICs a =>
+ Prism' a Aip_SUP_and_AICs
+ _Aip_SUP_and_AICs =
+ _IsAip_SUP_and_AICs
+
+instance AsAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _Aip_SUP_and_AICs =
+ id
+
+class FoldAip_SUP_and_AICs a where
+ _FoldAip_SUP_and_AICs ::
+ Fold a Aip_SUP_and_AICs
+
+instance FoldAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _FoldAip_SUP_and_AICs =
+ id
+
+class FoldAip_SUP_and_AICs a => GetAip_SUP_and_AICs a where
+ _GetAip_SUP_and_AICs ::
+ Getter a Aip_SUP_and_AICs
+ default _GetAip_SUP_and_AICs ::
+ HasAip_SUP_and_AICs a =>
+ Getter a Aip_SUP_and_AICs
+ _GetAip_SUP_and_AICs =
+ aip_SUP_and_AICs
+
+instance GetAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _GetAip_SUP_and_AICs =
+ id
+
+class SetAip_SUP_and_AICs a where
+ _SetAip_SUP_and_AICs ::
+ Setter' a Aip_SUP_and_AICs
+ default _SetAip_SUP_and_AICs ::
+ ManyAip_SUP_and_AICs a =>
+ Setter' a Aip_SUP_and_AICs
+ _SetAip_SUP_and_AICs =
+ _ManyAip_SUP_and_AICs
+
+instance SetAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _SetAip_SUP_and_AICs =
+ id
+
+class (FoldAip_SUP_and_AICs a, SetAip_SUP_and_AICs a) => ManyAip_SUP_and_AICs a where
+ _ManyAip_SUP_and_AICs ::
+ Traversal' a Aip_SUP_and_AICs
+
+instance ManyAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _ManyAip_SUP_and_AICs =
+ id
+
+class (GetAip_SUP_and_AICs a, ManyAip_SUP_and_AICs a) => HasAip_SUP_and_AICs a where
+ aip_SUP_and_AICs ::
+ Lens' a Aip_SUP_and_AICs
+ default aip_SUP_and_AICs ::
+ IsAip_SUP_and_AICs a =>
+ Lens' a Aip_SUP_and_AICs
+ aip_SUP_and_AICs =
+ _IsAip_SUP_and_AICs
+
+instance HasAip_SUP_and_AICs Aip_SUP_and_AICs where
+ aip_SUP_and_AICs =
+ id
+
+class (HasAip_SUP_and_AICs a, AsAip_SUP_and_AICs a) => IsAip_SUP_and_AICs a where
+ _IsAip_SUP_and_AICs ::
+ Iso' a Aip_SUP_and_AICs
+
+instance IsAip_SUP_and_AICs Aip_SUP_and_AICs where
+ _IsAip_SUP_and_AICs =
+ id
+
+instance SetAip_SUP_and_AICs () where
+instance FoldAip_SUP_and_AICs () where
+ _FoldAip_SUP_and_AICs =
+ _ManyAip_SUP_and_AICs
+instance ManyAip_SUP_and_AICs () where
+ _ManyAip_SUP_and_AICs _ x =
+ pure x
+
+----
+
+instance SetHref Aip_SUP_and_AICs where
+instance FoldHref Aip_SUP_and_AICs where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref Aip_SUP_and_AICs where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/Amendment.hs b/src/Data/Aviation/Aip/Amendment.hs
new file mode 100644
index 0000000..583b5ee
--- /dev/null
+++ b/src/Data/Aviation/Aip/Amendment.hs
@@ -0,0 +1,201 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Amendment(
+ Amendment(..)
+, AsAmendment(..)
+, FoldAmendment(..)
+, GetAmendment(..)
+, SetAmendment(..)
+, ManyAmendment(..)
+, HasAmendment(..)
+, IsAmendment(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Char(Char)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+newtype Amendment =
+ Amendment
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON Amendment where
+ parseJSON v =
+ Amendment <$> parseJSON v
+
+instance ToJSON Amendment where
+ toJSON (Amendment x) =
+ toJSON x
+
+instance Semigroup Amendment where
+ Amendment x <> Amendment y =
+ Amendment (x <> y)
+
+instance Monoid Amendment where
+ mappend =
+ (<>)
+ mempty =
+ Amendment mempty
+
+instance Cons Amendment Amendment Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc Amendment Amendment Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each Amendment Amendment Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing Amendment where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated Amendment where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue Amendment = Char
+type instance Index Amendment = Int
+instance Ixed Amendment where
+ ix i =
+ _Wrapped . ix i
+
+instance Wrapped Amendment where
+ type Unwrapped Amendment = String
+ _Wrapped' =
+ iso
+ (\(Amendment x) -> x)
+ Amendment
+
+instance Amendment ~ a =>
+ Rewrapped Amendment a
+
+class ManyAmendment a => AsAmendment a where
+ _Amendment ::
+ Prism' a Amendment
+ default _Amendment ::
+ IsAmendment a =>
+ Prism' a Amendment
+ _Amendment =
+ _IsAmendment
+
+instance AsAmendment Amendment where
+ _Amendment =
+ id
+
+instance AsAmendment String where
+ _Amendment =
+ from _Wrapped
+
+class FoldAmendment a where
+ _FoldAmendment ::
+ Fold a Amendment
+
+instance FoldAmendment Amendment where
+ _FoldAmendment =
+ id
+
+instance FoldAmendment String where
+ _FoldAmendment =
+ from _Wrapped
+
+class FoldAmendment a => GetAmendment a where
+ _GetAmendment ::
+ Getter a Amendment
+ default _GetAmendment ::
+ HasAmendment a =>
+ Getter a Amendment
+ _GetAmendment =
+ amendment
+
+instance GetAmendment Amendment where
+ _GetAmendment =
+ id
+
+instance GetAmendment String where
+ _GetAmendment =
+ from _Wrapped
+
+class SetAmendment a where
+ _SetAmendment ::
+ Setter' a Amendment
+ default _SetAmendment ::
+ ManyAmendment a =>
+ Setter' a Amendment
+ _SetAmendment =
+ _ManyAmendment
+
+instance SetAmendment Amendment where
+ _SetAmendment =
+ id
+
+instance SetAmendment String where
+ _SetAmendment =
+ from _Wrapped
+
+class (FoldAmendment a, SetAmendment a) => ManyAmendment a where
+ _ManyAmendment ::
+ Traversal' a Amendment
+
+instance ManyAmendment Amendment where
+ _ManyAmendment =
+ id
+
+instance ManyAmendment String where
+ _ManyAmendment =
+ from _Wrapped
+
+class (GetAmendment a, ManyAmendment a) => HasAmendment a where
+ amendment ::
+ Lens' a Amendment
+ default amendment ::
+ IsAmendment a =>
+ Lens' a Amendment
+ amendment =
+ _IsAmendment
+
+instance HasAmendment Amendment where
+ amendment =
+ id
+
+instance HasAmendment String where
+ amendment =
+ from _Wrapped
+
+class (HasAmendment a, AsAmendment a) => IsAmendment a where
+ _IsAmendment ::
+ Iso' a Amendment
+
+instance IsAmendment Amendment where
+ _IsAmendment =
+ id
+
+instance IsAmendment String where
+ _IsAmendment =
+ from _Wrapped
+
+instance SetAmendment () where
+instance FoldAmendment () where
+ _FoldAmendment =
+ _ManyAmendment
+instance ManyAmendment () where
+ _ManyAmendment _ x =
+ pure x
diff --git a/src/Data/Aviation/Aip/Cache.hs b/src/Data/Aviation/Aip/Cache.hs
new file mode 100644
index 0000000..f3bb65e
--- /dev/null
+++ b/src/Data/Aviation/Aip/Cache.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Cache(
+ Cache(..)
+, AsCache(..)
+, FoldCache(..)
+, GetCache(..)
+, SetCache(..)
+, ManyCache(..)
+, HasCache(..)
+, IsCache(..)
+, AsReadCache(..)
+, AsReadWriteCache(..)
+, AsNoCache(..)
+, isReadOrWriteCache
+, isWriteCache
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Bool(Bool, not)
+import Data.Eq(Eq)
+import Data.Foldable(any)
+import Data.Maybe(Maybe(Just, Nothing))
+import Data.Ord(Ord)
+import Prelude(Show)
+
+data Cache =
+ ReadCache
+ | ReadWriteCache
+ | NoCache
+ deriving (Eq, Ord, Show)
+
+class ManyCache a => AsCache a where
+ _Cache ::
+ Prism' a Cache
+ default _Cache ::
+ IsCache a =>
+ Prism' a Cache
+ _Cache =
+ _IsCache
+
+instance AsCache Cache where
+ _Cache =
+ id
+
+class FoldCache a where
+ _FoldCache ::
+ Fold a Cache
+
+instance FoldCache Cache where
+ _FoldCache =
+ id
+
+class FoldCache a => GetCache a where
+ _GetCache ::
+ Getter a Cache
+ default _GetCache ::
+ HasCache a =>
+ Getter a Cache
+ _GetCache =
+ cache
+
+instance GetCache Cache where
+ _GetCache =
+ id
+
+class SetCache a where
+ _SetCache ::
+ Setter' a Cache
+ default _SetCache ::
+ ManyCache a =>
+ Setter' a Cache
+ _SetCache =
+ _ManyCache
+
+instance SetCache Cache where
+ _SetCache =
+ id
+
+class (FoldCache a, SetCache a) => ManyCache a where
+ _ManyCache ::
+ Traversal' a Cache
+
+instance ManyCache Cache where
+ _ManyCache =
+ id
+
+class (GetCache a, ManyCache a) => HasCache a where
+ cache ::
+ Lens' a Cache
+ default cache ::
+ IsCache a =>
+ Lens' a Cache
+ cache =
+ _IsCache
+
+instance HasCache Cache where
+ cache =
+ id
+
+class (HasCache a, AsCache a) => IsCache a where
+ _IsCache ::
+ Iso' a Cache
+
+instance IsCache Cache where
+ _IsCache =
+ id
+
+instance SetCache () where
+instance FoldCache () where
+ _FoldCache =
+ _ManyCache
+instance ManyCache () where
+ _ManyCache _ x =
+ pure x
+
+----
+
+
+class AsReadCache a where
+ _ReadCache ::
+ Prism'
+ a
+ ()
+
+instance AsReadCache () where
+ _ReadCache =
+ id
+
+instance AsReadCache Cache where
+ _ReadCache =
+ prism'
+ (\() -> ReadCache)
+ (\c -> case c of
+ ReadCache ->
+ Just ()
+ _ ->
+ Nothing)
+
+class AsReadWriteCache a where
+ _ReadWriteCache ::
+ Prism'
+ a
+ ()
+
+instance AsReadWriteCache () where
+ _ReadWriteCache =
+ id
+
+instance AsReadWriteCache Cache where
+ _ReadWriteCache =
+ prism'
+ (\() -> ReadWriteCache)
+ (\c -> case c of
+ ReadWriteCache ->
+ Just ()
+ _ ->
+ Nothing)
+
+class AsNoCache a where
+ _NoCache ::
+ Prism'
+ a
+ ()
+
+instance AsNoCache () where
+ _NoCache =
+ id
+
+instance AsNoCache Cache where
+ _NoCache =
+ prism'
+ (\() -> NoCache)
+ (\c -> case c of
+ NoCache ->
+ Just ()
+ _ ->
+ Nothing)
+
+isReadOrWriteCache ::
+ (AsReadCache t, AsReadWriteCache t) =>
+ t
+ -> Bool
+isReadOrWriteCache x =
+ any (\p' -> not (isn't p' x)) [_ReadCache, _ReadWriteCache]
+
+isWriteCache ::
+ AsReadWriteCache t =>
+ t
+ -> Bool
+isWriteCache x =
+ not (isn't _ReadWriteCache x)
+
diff --git a/src/Data/Aviation/Aip/ConnErrorHttp4xx.hs b/src/Data/Aviation/Aip/ConnErrorHttp4xx.hs
index 82a43f3..cc19511 100644
--- a/src/Data/Aviation/Aip/ConnErrorHttp4xx.hs
+++ b/src/Data/Aviation/Aip/ConnErrorHttp4xx.hs
@@ -1,16 +1,112 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# OPTIONS_HADDOCK prune #-}
module Data.Aviation.Aip.ConnErrorHttp4xx(
ConnErrorHttp4xx(..)
+, AsConnErrorHttp4xx(..)
+, FoldConnErrorHttp4xx(..)
+, GetConnErrorHttp4xx(..)
+, SetConnErrorHttp4xx(..)
+, ManyConnErrorHttp4xx(..)
+, HasConnErrorHttp4xx(..)
+, IsConnErrorHttp4xx(..)
) where
+import Control.Category(id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Eq(Eq)
+import Data.Int(Int)
import Network.Stream(ConnError)
-import Papa
+import Prelude(Show)
data ConnErrorHttp4xx =
IsConnError ConnError
| Http4xx Int Int
deriving (Eq, Show)
-makeClassyPrisms ''ConnErrorHttp4xx
+class AsConnErrorHttp4xx a where
+ _ConnErrorHttp4xx ::
+ Prism' a ConnErrorHttp4xx
+ default _ConnErrorHttp4xx ::
+ IsConnErrorHttp4xx a =>
+ Prism' a ConnErrorHttp4xx
+ _ConnErrorHttp4xx =
+ _IsConnErrorHttp4xx
+
+instance AsConnErrorHttp4xx ConnErrorHttp4xx where
+ _ConnErrorHttp4xx =
+ id
+
+class FoldConnErrorHttp4xx a where
+ _FoldConnErrorHttp4xx ::
+ Fold a ConnErrorHttp4xx
+
+instance FoldConnErrorHttp4xx ConnErrorHttp4xx where
+ _FoldConnErrorHttp4xx =
+ id
+
+class FoldConnErrorHttp4xx a => GetConnErrorHttp4xx a where
+ _GetConnErrorHttp4xx ::
+ Getter a ConnErrorHttp4xx
+ default _GetConnErrorHttp4xx ::
+ HasConnErrorHttp4xx a =>
+ Getter a ConnErrorHttp4xx
+ _GetConnErrorHttp4xx =
+ connErrorHttp4xx
+
+instance GetConnErrorHttp4xx ConnErrorHttp4xx where
+ _GetConnErrorHttp4xx =
+ id
+
+class SetConnErrorHttp4xx a where
+ _SetConnErrorHttp4xx ::
+ Setter' a ConnErrorHttp4xx
+ default _SetConnErrorHttp4xx ::
+ ManyConnErrorHttp4xx a =>
+ Setter' a ConnErrorHttp4xx
+ _SetConnErrorHttp4xx =
+ _ManyConnErrorHttp4xx
+
+instance SetConnErrorHttp4xx ConnErrorHttp4xx where
+ _SetConnErrorHttp4xx =
+ id
+
+class (FoldConnErrorHttp4xx a, SetConnErrorHttp4xx a) => ManyConnErrorHttp4xx a where
+ _ManyConnErrorHttp4xx ::
+ Traversal' a ConnErrorHttp4xx
+
+instance ManyConnErrorHttp4xx ConnErrorHttp4xx where
+ _ManyConnErrorHttp4xx =
+ id
+
+class (GetConnErrorHttp4xx a, ManyConnErrorHttp4xx a) => HasConnErrorHttp4xx a where
+ connErrorHttp4xx ::
+ Lens' a ConnErrorHttp4xx
+ default connErrorHttp4xx ::
+ IsConnErrorHttp4xx a =>
+ Lens' a ConnErrorHttp4xx
+ connErrorHttp4xx =
+ _IsConnErrorHttp4xx
+
+instance HasConnErrorHttp4xx ConnErrorHttp4xx where
+ connErrorHttp4xx =
+ id
+
+class (HasConnErrorHttp4xx a, AsConnErrorHttp4xx a) => IsConnErrorHttp4xx a where
+ _IsConnErrorHttp4xx ::
+ Iso' a ConnErrorHttp4xx
+
+instance IsConnErrorHttp4xx ConnErrorHttp4xx where
+ _IsConnErrorHttp4xx =
+ id
+
+instance SetConnErrorHttp4xx () where
+instance FoldConnErrorHttp4xx () where
+ _FoldConnErrorHttp4xx =
+ _ManyConnErrorHttp4xx
+instance ManyConnErrorHttp4xx () where
+ _ManyConnErrorHttp4xx _ x =
+ pure x
diff --git a/src/Data/Aviation/Aip/DAPDoc.hs b/src/Data/Aviation/Aip/DAPDoc.hs
new file mode 100644
index 0000000..d27f9db
--- /dev/null
+++ b/src/Data/Aviation/Aip/DAPDoc.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.DAPDoc(
+ DAPDoc(..)
+, AsDAPDoc(..)
+, FoldDAPDoc(..)
+, GetDAPDoc(..)
+, SetDAPDoc(..)
+, ManyDAPDoc(..)
+, HasDAPDoc(..)
+, IsDAPDoc(..)
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Aviation.Aip.DAPType(DAPType)
+import Data.Aviation.Aip.DAPEntries(DAPEntries, FoldDAPEntries(_FoldDAPEntries), GetDAPEntries, SetDAPEntries, ManyDAPEntries(_ManyDAPEntries), HasDAPEntries(dapEntries))
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor(fmap, (<$>))
+import Data.Ord(Ord)
+import Data.String(String)
+import Prelude(Show)
+
+data DAPDoc =
+ DAPDoc
+ (DAPType String)
+ Href
+ DAPEntries
+ deriving (Eq, Ord, Show)
+
+instance FromJSON DAPDoc where
+ parseJSON =
+ withObject "DAPDoc" $ \v ->
+ DAPDoc <$>
+ v .: "type" <*>
+ v .: "href" <*>
+ v .: "entries"
+
+instance ToJSON DAPDoc where
+ toJSON (DAPDoc typ u entries) =
+ object ["type" .= typ, "href" .= u, "entries" .= entries]
+
+class ManyDAPDoc a => AsDAPDoc a where
+ _DAPDoc ::
+ Prism' a DAPDoc
+ default _DAPDoc ::
+ IsDAPDoc a =>
+ Prism' a DAPDoc
+ _DAPDoc =
+ _IsDAPDoc
+
+instance AsDAPDoc DAPDoc where
+ _DAPDoc =
+ id
+
+class FoldDAPDoc a where
+ _FoldDAPDoc ::
+ Fold a DAPDoc
+
+instance FoldDAPDoc DAPDoc where
+ _FoldDAPDoc =
+ id
+
+class FoldDAPDoc a => GetDAPDoc a where
+ _GetDAPDoc ::
+ Getter a DAPDoc
+ default _GetDAPDoc ::
+ HasDAPDoc a =>
+ Getter a DAPDoc
+ _GetDAPDoc =
+ dapDoc
+
+instance GetDAPDoc DAPDoc where
+ _GetDAPDoc =
+ id
+
+class SetDAPDoc a where
+ _SetDAPDoc ::
+ Setter' a DAPDoc
+ default _SetDAPDoc ::
+ ManyDAPDoc a =>
+ Setter' a DAPDoc
+ _SetDAPDoc =
+ _ManyDAPDoc
+
+instance SetDAPDoc DAPDoc where
+ _SetDAPDoc =
+ id
+
+class (FoldDAPDoc a, SetDAPDoc a) => ManyDAPDoc a where
+ _ManyDAPDoc ::
+ Traversal' a DAPDoc
+
+instance ManyDAPDoc DAPDoc where
+ _ManyDAPDoc =
+ id
+
+class (GetDAPDoc a, ManyDAPDoc a) => HasDAPDoc a where
+ dapDoc ::
+ Lens' a DAPDoc
+ default dapDoc ::
+ IsDAPDoc a =>
+ Lens' a DAPDoc
+ dapDoc =
+ _IsDAPDoc
+
+instance HasDAPDoc DAPDoc where
+ dapDoc =
+ id
+
+class (HasDAPDoc a, AsDAPDoc a) => IsDAPDoc a where
+ _IsDAPDoc ::
+ Iso' a DAPDoc
+
+instance IsDAPDoc DAPDoc where
+ _IsDAPDoc =
+ id
+
+instance SetDAPDoc () where
+instance FoldDAPDoc () where
+ _FoldDAPDoc =
+ _ManyDAPDoc
+instance ManyDAPDoc () where
+ _ManyDAPDoc _ x =
+ pure x
+
+instance SetHref DAPDoc where
+instance FoldHref DAPDoc where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref DAPDoc where
+ _ManyHref f (DAPDoc typ u entries) =
+ DAPDoc <$> pure typ <*> f u <*> _ManyHref f entries
+
+----
+
+instance FoldDAPEntries DAPDoc where
+ _FoldDAPEntries =
+ dapEntries
+instance GetDAPEntries DAPDoc where
+instance SetDAPEntries DAPDoc where
+instance ManyDAPEntries DAPDoc where
+ _ManyDAPEntries =
+ dapEntries
+instance HasDAPEntries DAPDoc where
+ dapEntries k (DAPDoc typ u entries) =
+ fmap (\entries' -> DAPDoc typ u entries') (k entries)
diff --git a/src/Data/Aviation/Aip/DAPDocs.hs b/src/Data/Aviation/Aip/DAPDocs.hs
new file mode 100644
index 0000000..1387e87
--- /dev/null
+++ b/src/Data/Aviation/Aip/DAPDocs.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Aviation.Aip.DAPDocs(
+ DAPDocs(..)
+, AsDAPDocs(..)
+, FoldDAPDocs(..)
+, GetDAPDocs(..)
+, SetDAPDocs(..)
+, ManyDAPDocs(..)
+, HasDAPDocs(..)
+, IsDAPDocs(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.DAPDoc(DAPDoc)
+import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+
+newtype DAPDocs =
+ DAPDocs
+ [DAPDoc]
+ deriving (Eq, Ord, Show)
+
+instance Semigroup DAPDocs where
+ DAPDocs x <> DAPDocs y =
+ DAPDocs (x <> y)
+
+instance Monoid DAPDocs where
+ mappend =
+ (<>)
+ mempty =
+ DAPDocs mempty
+
+instance FromJSON DAPDocs where
+ parseJSON =
+ withArray "DAPDocs" $ \v ->
+ DAPDocs <$> traverse parseJSON (toList v)
+
+instance ToJSON DAPDocs where
+ toJSON (DAPDocs x) =
+ toJSON x
+
+instance Wrapped DAPDocs where
+ type Unwrapped DAPDocs =
+ [DAPDoc]
+ _Wrapped' =
+ iso (\(DAPDocs x) -> x) DAPDocs
+
+instance DAPDocs ~ x =>
+ Rewrapped DAPDocs x
+
+instance Cons DAPDocs DAPDocs DAPDoc DAPDoc where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc DAPDocs DAPDocs DAPDoc DAPDoc where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each DAPDocs DAPDocs DAPDoc DAPDoc where
+ each =
+ _Wrapped . each
+
+instance Reversing DAPDocs where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated DAPDocs where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue DAPDocs = DAPDoc
+type instance Index DAPDocs = Int
+instance Ixed DAPDocs where
+ ix i =
+ _Wrapped . ix i
+
+class ManyDAPDocs a => AsDAPDocs a where
+ _DAPDocs ::
+ Prism' a DAPDocs
+ default _DAPDocs ::
+ IsDAPDocs a =>
+ Prism' a DAPDocs
+ _DAPDocs =
+ _IsDAPDocs
+
+instance AsDAPDocs DAPDocs where
+ _DAPDocs =
+ id
+
+class FoldDAPDocs a where
+ _FoldDAPDocs ::
+ Fold a DAPDocs
+
+instance FoldDAPDocs DAPDocs where
+ _FoldDAPDocs =
+ id
+
+class FoldDAPDocs a => GetDAPDocs a where
+ _GetDAPDocs ::
+ Getter a DAPDocs
+ default _GetDAPDocs ::
+ HasDAPDocs a =>
+ Getter a DAPDocs
+ _GetDAPDocs =
+ dapDocs
+
+instance GetDAPDocs DAPDocs where
+ _GetDAPDocs =
+ id
+
+class SetDAPDocs a where
+ _SetDAPDocs ::
+ Setter' a DAPDocs
+ default _SetDAPDocs ::
+ ManyDAPDocs a =>
+ Setter' a DAPDocs
+ _SetDAPDocs =
+ _ManyDAPDocs
+
+instance SetDAPDocs DAPDocs where
+ _SetDAPDocs =
+ id
+
+class (FoldDAPDocs a, SetDAPDocs a) => ManyDAPDocs a where
+ _ManyDAPDocs ::
+ Traversal' a DAPDocs
+
+instance ManyDAPDocs DAPDocs where
+ _ManyDAPDocs =
+ id
+
+class (GetDAPDocs a, ManyDAPDocs a) => HasDAPDocs a where
+ dapDocs ::
+ Lens' a DAPDocs
+ default dapDocs ::
+ IsDAPDocs a =>
+ Lens' a DAPDocs
+ dapDocs =
+ _IsDAPDocs
+
+instance HasDAPDocs DAPDocs where
+ dapDocs =
+ id
+
+class (HasDAPDocs a, AsDAPDocs a) => IsDAPDocs a where
+ _IsDAPDocs ::
+ Iso' a DAPDocs
+
+instance IsDAPDocs DAPDocs where
+ _IsDAPDocs =
+ id
+
+instance SetDAPDocs () where
+instance FoldDAPDocs () where
+ _FoldDAPDocs =
+ _ManyDAPDocs
+instance ManyDAPDocs () where
+ _ManyDAPDocs _ x =
+ pure x
+
+instance SetHref DAPDocs where
+instance FoldHref DAPDocs where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref DAPDocs where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/DAPEntries.hs b/src/Data/Aviation/Aip/DAPEntries.hs
new file mode 100644
index 0000000..a341b24
--- /dev/null
+++ b/src/Data/Aviation/Aip/DAPEntries.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.DAPEntries(
+ DAPEntries(..)
+, AsDAPEntries(..)
+, FoldDAPEntries(..)
+, GetDAPEntries(..)
+, SetDAPEntries(..)
+, ManyDAPEntries(..)
+, HasDAPEntries(..)
+, IsDAPEntries(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Aviation.Aip.DAPEntry(DAPEntry)
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+
+newtype DAPEntries =
+ DAPEntries
+ [DAPEntry]
+ deriving (Eq, Ord, Show)
+
+instance Semigroup DAPEntries where
+ DAPEntries x <> DAPEntries y =
+ DAPEntries (x <> y)
+
+instance Monoid DAPEntries where
+ mappend =
+ (<>)
+ mempty =
+ DAPEntries mempty
+
+instance Wrapped DAPEntries where
+ type Unwrapped DAPEntries = [DAPEntry]
+ _Wrapped' =
+ iso
+ (\(DAPEntries x) -> x)
+ DAPEntries
+
+instance DAPEntries ~ a =>
+ Rewrapped DAPEntries a
+
+instance FromJSON DAPEntries where
+ parseJSON =
+ withArray "DAPEntries" $ \v ->
+ DAPEntries <$> traverse parseJSON (toList v)
+
+instance ToJSON DAPEntries where
+ toJSON (DAPEntries x) =
+ toJSON x
+
+instance Cons DAPEntries DAPEntries DAPEntry DAPEntry where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc DAPEntries DAPEntries DAPEntry DAPEntry where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each DAPEntries DAPEntries DAPEntry DAPEntry where
+ each =
+ _Wrapped . each
+
+instance Reversing DAPEntries where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated DAPEntries where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue DAPEntries = DAPEntry
+type instance Index DAPEntries = Int
+instance Ixed DAPEntries where
+ ix i =
+ _Wrapped . ix i
+
+class ManyDAPEntries a => AsDAPEntries a where
+ _DAPEntries ::
+ Prism' a DAPEntries
+ default _DAPEntries ::
+ IsDAPEntries a =>
+ Prism' a DAPEntries
+ _DAPEntries =
+ _IsDAPEntries
+
+instance AsDAPEntries DAPEntries where
+ _DAPEntries =
+ id
+
+class FoldDAPEntries a where
+ _FoldDAPEntries ::
+ Fold a DAPEntries
+
+instance FoldDAPEntries DAPEntries where
+ _FoldDAPEntries =
+ id
+
+class FoldDAPEntries a => GetDAPEntries a where
+ _GetDAPEntries ::
+ Getter a DAPEntries
+ default _GetDAPEntries ::
+ HasDAPEntries a =>
+ Getter a DAPEntries
+ _GetDAPEntries =
+ dapEntries
+
+instance GetDAPEntries DAPEntries where
+ _GetDAPEntries =
+ id
+
+class SetDAPEntries a where
+ _SetDAPEntries ::
+ Setter' a DAPEntries
+ default _SetDAPEntries ::
+ ManyDAPEntries a =>
+ Setter' a DAPEntries
+ _SetDAPEntries =
+ _ManyDAPEntries
+
+instance SetDAPEntries DAPEntries where
+ _SetDAPEntries =
+ id
+
+class (FoldDAPEntries a, SetDAPEntries a) => ManyDAPEntries a where
+ _ManyDAPEntries ::
+ Traversal' a DAPEntries
+
+instance ManyDAPEntries DAPEntries where
+ _ManyDAPEntries =
+ id
+
+class (GetDAPEntries a, ManyDAPEntries a) => HasDAPEntries a where
+ dapEntries ::
+ Lens' a DAPEntries
+ default dapEntries ::
+ IsDAPEntries a =>
+ Lens' a DAPEntries
+ dapEntries =
+ _IsDAPEntries
+
+instance HasDAPEntries DAPEntries where
+ dapEntries =
+ id
+
+class (HasDAPEntries a, AsDAPEntries a) => IsDAPEntries a where
+ _IsDAPEntries ::
+ Iso' a DAPEntries
+
+instance IsDAPEntries DAPEntries where
+ _IsDAPEntries =
+ id
+
+instance SetDAPEntries () where
+instance FoldDAPEntries () where
+ _FoldDAPEntries =
+ _ManyDAPEntries
+instance ManyDAPEntries () where
+ _ManyDAPEntries _ x =
+ pure x
+
+instance SetHref DAPEntries where
+instance FoldHref DAPEntries where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref DAPEntries where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/DAPEntry.hs b/src/Data/Aviation/Aip/DAPEntry.hs
new file mode 100644
index 0000000..41f8727
--- /dev/null
+++ b/src/Data/Aviation/Aip/DAPEntry.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.DAPEntry(
+ DAPEntry(..)
+, AsDAPEntry(..)
+, FoldDAPEntry(..)
+, GetDAPEntry(..)
+, SetDAPEntry(..)
+, ManyDAPEntry(..)
+, HasDAPEntry(..)
+, IsDAPEntry(..)
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Aviation.Aip.AipDate(AipDate)
+import Data.Aviation.Aip.Amendment(Amendment)
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref), GetHref, HasHref(href))
+import Data.Aviation.Aip.Txt(Txt)
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor(fmap, (<$>))
+import Data.Ord(Ord)
+import Prelude(Show)
+
+data DAPEntry =
+ DAPEntry
+ Href
+ Txt
+ AipDate
+ Amendment
+ deriving (Eq, Ord, Show)
+
+instance FromJSON DAPEntry where
+ parseJSON =
+ withObject "DAPEntry" $ \v ->
+ DAPEntry <$>
+ v .: "href" <*>
+ v .: "txt" <*>
+ v .: "date" <*>
+ v .: "amendment"
+
+instance ToJSON DAPEntry where
+ toJSON (DAPEntry u txt date amendment) =
+ object ["href" .= u, "txt" .= txt, "date" .= date, "amendment" .= amendment]
+
+class ManyDAPEntry a => AsDAPEntry a where
+ _DAPEntry ::
+ Prism' a DAPEntry
+ default _DAPEntry ::
+ IsDAPEntry a =>
+ Prism' a DAPEntry
+ _DAPEntry =
+ _IsDAPEntry
+
+instance AsDAPEntry DAPEntry where
+ _DAPEntry =
+ id
+
+class FoldDAPEntry a where
+ _FoldDAPEntry ::
+ Fold a DAPEntry
+
+instance FoldDAPEntry DAPEntry where
+ _FoldDAPEntry =
+ id
+
+class FoldDAPEntry a => GetDAPEntry a where
+ _GetDAPEntry ::
+ Getter a DAPEntry
+ default _GetDAPEntry ::
+ HasDAPEntry a =>
+ Getter a DAPEntry
+ _GetDAPEntry =
+ dapEntry
+
+instance GetDAPEntry DAPEntry where
+ _GetDAPEntry =
+ id
+
+class SetDAPEntry a where
+ _SetDAPEntry ::
+ Setter' a DAPEntry
+ default _SetDAPEntry ::
+ ManyDAPEntry a =>
+ Setter' a DAPEntry
+ _SetDAPEntry =
+ _ManyDAPEntry
+
+instance SetDAPEntry DAPEntry where
+ _SetDAPEntry =
+ id
+
+class (FoldDAPEntry a, SetDAPEntry a) => ManyDAPEntry a where
+ _ManyDAPEntry ::
+ Traversal' a DAPEntry
+
+instance ManyDAPEntry DAPEntry where
+ _ManyDAPEntry =
+ id
+
+class (GetDAPEntry a, ManyDAPEntry a) => HasDAPEntry a where
+ dapEntry ::
+ Lens' a DAPEntry
+ default dapEntry ::
+ IsDAPEntry a =>
+ Lens' a DAPEntry
+ dapEntry =
+ _IsDAPEntry
+
+instance HasDAPEntry DAPEntry where
+ dapEntry =
+ id
+
+class (HasDAPEntry a, AsDAPEntry a) => IsDAPEntry a where
+ _IsDAPEntry ::
+ Iso' a DAPEntry
+
+instance IsDAPEntry DAPEntry where
+ _IsDAPEntry =
+ id
+
+instance SetDAPEntry () where
+instance FoldDAPEntry () where
+ _FoldDAPEntry =
+ _ManyDAPEntry
+instance ManyDAPEntry () where
+ _ManyDAPEntry _ x =
+ pure x
+
+instance SetHref DAPEntry where
+instance FoldHref DAPEntry where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref DAPEntry where
+ _ManyHref f (DAPEntry u txt date amendment) =
+ DAPEntry <$> f u <*> pure txt <*> pure date <*> pure amendment
+
+instance GetHref DAPEntry where
+instance HasHref DAPEntry where
+ href f (DAPEntry u txt date amendment) =
+ fmap (\u' -> DAPEntry u' txt date amendment) (f u)
diff --git a/src/Data/Aviation/Aip/DAPType.hs b/src/Data/Aviation/Aip/DAPType.hs
new file mode 100644
index 0000000..3307ff5
--- /dev/null
+++ b/src/Data/Aviation/Aip/DAPType.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.DAPType(
+ DAPType(..)
+, DAPType'
+, AsDAPType(..)
+, FoldDAPType(..)
+, GetDAPType(..)
+, SetDAPType(..)
+, ManyDAPType(..)
+, HasDAPType(..)
+, IsDAPType(..)
+) where
+
+import Control.Category(id)
+import Control.Lens hiding ((.=))
+import Control.Monad(fail)
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Object), object, (.=))
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import qualified Data.HashMap.Strict as HashMap(toList)
+import Data.Ord(Ord)
+import Prelude(Show)
+
+data DAPType aerodrome =
+ SpecNotManTOCDAP
+ | ChecklistTOCDAP
+ | LegendInfoTablesTOCDAP
+ | AeroProcChartsTOCDAP aerodrome
+ deriving (Eq, Ord, Show)
+
+type DAPType' =
+ DAPType ()
+
+instance FromJSON aerodrome => FromJSON (DAPType aerodrome) where
+ parseJSON (Object z) =
+ case HashMap.toList z of
+ [("SpecNotManTOCDAP", q)] ->
+ (\() -> SpecNotManTOCDAP) <$> parseJSON q
+ [("ChecklistTOCDAP", q)] ->
+ (\() -> ChecklistTOCDAP) <$> parseJSON q
+ [("LegendInfoTablesTOCDAP", q)] ->
+ (\() -> LegendInfoTablesTOCDAP) <$> parseJSON q
+ [("AeroProcChartsTOCDAP", q)] ->
+ AeroProcChartsTOCDAP <$> parseJSON q
+ _ ->
+ fail "DAPType"
+ parseJSON _ =
+ fail "DAPType"
+
+instance ToJSON aerodrome => ToJSON (DAPType aerodrome) where
+ toJSON SpecNotManTOCDAP =
+ object ["SpecNotManTOCDAP" .= toJSON ()]
+ toJSON ChecklistTOCDAP =
+ object ["ChecklistTOCDAP" .= toJSON ()]
+ toJSON LegendInfoTablesTOCDAP =
+ object ["LegendInfoTablesTOCDAP" .= toJSON ()]
+ toJSON (AeroProcChartsTOCDAP x) =
+ object ["AeroProcChartsTOCDAP" .= toJSON x]
+
+class ManyDAPType a => AsDAPType a where
+ _DAPType ::
+ Prism (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ default _DAPType ::
+ IsDAPType a =>
+ Prism (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ _DAPType =
+ _IsDAPType
+
+instance AsDAPType DAPType where
+ _DAPType =
+ id
+
+class FoldDAPType a where
+ _FoldDAPType ::
+ Fold (a aerodrome) (DAPType aerodrome)
+
+instance FoldDAPType DAPType where
+ _FoldDAPType =
+ id
+
+class FoldDAPType a => GetDAPType a where
+ _GetDAPType ::
+ Getter (a aerodrome) (DAPType aerodrome)
+ default _GetDAPType ::
+ HasDAPType a =>
+ Getter (a aerodrome) (DAPType aerodrome)
+ _GetDAPType =
+ dapType
+
+instance GetDAPType DAPType where
+ _GetDAPType =
+ id
+
+class SetDAPType a where
+ _SetDAPType ::
+ Setter (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ default _SetDAPType ::
+ ManyDAPType a =>
+ Setter (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ _SetDAPType =
+ _ManyDAPType
+
+instance SetDAPType DAPType where
+ _SetDAPType =
+ id
+
+class (FoldDAPType a, SetDAPType a) => ManyDAPType a where
+ _ManyDAPType ::
+ Traversal (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+
+instance ManyDAPType DAPType where
+ _ManyDAPType =
+ id
+
+class (GetDAPType a, ManyDAPType a) => HasDAPType a where
+ dapType ::
+ Lens (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ default dapType ::
+ IsDAPType a =>
+ Lens (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+ dapType =
+ _IsDAPType
+
+instance HasDAPType DAPType where
+ dapType =
+ id
+
+class (HasDAPType a, AsDAPType a) => IsDAPType a where
+ _IsDAPType ::
+ Iso (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
+
+instance IsDAPType DAPType where
+ _IsDAPType =
+ id
diff --git a/src/Data/Aviation/Aip/Day.hs b/src/Data/Aviation/Aip/Day.hs
deleted file mode 100644
index 29ae247..0000000
--- a/src/Data/Aviation/Aip/Day.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Data.Aviation.Aip.Day(
- Day(..)
-, parseDay
-, HasDay(..)
-) where
-
-import Data.Digit(Digit, parsedigit)
-import Text.Parser.Char(CharParsing)
-import Papa
-
-data Day =
- Day {
- _day1 ::
- Digit
- , _day2 ::
- Digit
- } deriving (Eq, Ord, Show)
-
-parseDay ::
- (CharParsing p, Monad p) =>
- p Day
-parseDay =
- Day <$> parsedigit <*> parsedigit
-
-makeClassy ''Day
diff --git a/src/Data/Aviation/Aip/DocumentNumber.hs b/src/Data/Aviation/Aip/DocumentNumber.hs
new file mode 100644
index 0000000..4a07f5f
--- /dev/null
+++ b/src/Data/Aviation/Aip/DocumentNumber.hs
@@ -0,0 +1,201 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.DocumentNumber(
+ DocumentNumber(..)
+, AsDocumentNumber(..)
+, FoldDocumentNumber(..)
+, GetDocumentNumber(..)
+, SetDocumentNumber(..)
+, ManyDocumentNumber(..)
+, HasDocumentNumber(..)
+, IsDocumentNumber(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Char(Char)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+newtype DocumentNumber =
+ DocumentNumber
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON DocumentNumber where
+ parseJSON v =
+ DocumentNumber <$> parseJSON v
+
+instance ToJSON DocumentNumber where
+ toJSON (DocumentNumber x) =
+ toJSON x
+
+instance Semigroup DocumentNumber where
+ DocumentNumber x <> DocumentNumber y =
+ DocumentNumber (x <> y)
+
+instance Monoid DocumentNumber where
+ mappend =
+ (<>)
+ mempty =
+ DocumentNumber mempty
+
+instance Cons DocumentNumber DocumentNumber Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc DocumentNumber DocumentNumber Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each DocumentNumber DocumentNumber Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing DocumentNumber where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated DocumentNumber where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue DocumentNumber = Char
+type instance Index DocumentNumber = Int
+instance Ixed DocumentNumber where
+ ix i =
+ _Wrapped . ix i
+
+instance Wrapped DocumentNumber where
+ type Unwrapped DocumentNumber = String
+ _Wrapped' =
+ iso
+ (\(DocumentNumber x) -> x)
+ DocumentNumber
+
+instance DocumentNumber ~ a =>
+ Rewrapped DocumentNumber a
+
+class ManyDocumentNumber a => AsDocumentNumber a where
+ _DocumentNumber ::
+ Prism' a DocumentNumber
+ default _DocumentNumber ::
+ IsDocumentNumber a =>
+ Prism' a DocumentNumber
+ _DocumentNumber =
+ _IsDocumentNumber
+
+instance AsDocumentNumber DocumentNumber where
+ _DocumentNumber =
+ id
+
+instance AsDocumentNumber String where
+ _DocumentNumber =
+ from _Wrapped
+
+class FoldDocumentNumber a where
+ _FoldDocumentNumber ::
+ Fold a DocumentNumber
+
+instance FoldDocumentNumber DocumentNumber where
+ _FoldDocumentNumber =
+ id
+
+instance FoldDocumentNumber String where
+ _FoldDocumentNumber =
+ from _Wrapped
+
+class FoldDocumentNumber a => GetDocumentNumber a where
+ _GetDocumentNumber ::
+ Getter a DocumentNumber
+ default _GetDocumentNumber ::
+ HasDocumentNumber a =>
+ Getter a DocumentNumber
+ _GetDocumentNumber =
+ documentNumber
+
+instance GetDocumentNumber DocumentNumber where
+ _GetDocumentNumber =
+ id
+
+instance GetDocumentNumber String where
+ _GetDocumentNumber =
+ from _Wrapped
+
+class SetDocumentNumber a where
+ _SetDocumentNumber ::
+ Setter' a DocumentNumber
+ default _SetDocumentNumber ::
+ ManyDocumentNumber a =>
+ Setter' a DocumentNumber
+ _SetDocumentNumber =
+ _ManyDocumentNumber
+
+instance SetDocumentNumber DocumentNumber where
+ _SetDocumentNumber =
+ id
+
+instance SetDocumentNumber String where
+ _SetDocumentNumber =
+ from _Wrapped
+
+class (FoldDocumentNumber a, SetDocumentNumber a) => ManyDocumentNumber a where
+ _ManyDocumentNumber ::
+ Traversal' a DocumentNumber
+
+instance ManyDocumentNumber DocumentNumber where
+ _ManyDocumentNumber =
+ id
+
+instance ManyDocumentNumber String where
+ _ManyDocumentNumber =
+ from _Wrapped
+
+class (GetDocumentNumber a, ManyDocumentNumber a) => HasDocumentNumber a where
+ documentNumber ::
+ Lens' a DocumentNumber
+ default documentNumber ::
+ IsDocumentNumber a =>
+ Lens' a DocumentNumber
+ documentNumber =
+ _IsDocumentNumber
+
+instance HasDocumentNumber DocumentNumber where
+ documentNumber =
+ id
+
+instance HasDocumentNumber String where
+ documentNumber =
+ from _Wrapped
+
+class (HasDocumentNumber a, AsDocumentNumber a) => IsDocumentNumber a where
+ _IsDocumentNumber ::
+ Iso' a DocumentNumber
+
+instance IsDocumentNumber DocumentNumber where
+ _IsDocumentNumber =
+ id
+
+instance IsDocumentNumber String where
+ _IsDocumentNumber =
+ from _Wrapped
+
+instance SetDocumentNumber () where
+instance FoldDocumentNumber () where
+ _FoldDocumentNumber =
+ _ManyDocumentNumber
+instance ManyDocumentNumber () where
+ _ManyDocumentNumber _ x =
+ pure x
diff --git a/src/Data/Aviation/Aip/Ersa.hs b/src/Data/Aviation/Aip/Ersa.hs
index 38451a9..6d68679 100644
--- a/src/Data/Aviation/Aip/Ersa.hs
+++ b/src/Data/Aviation/Aip/Ersa.hs
@@ -1,21 +1,153 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
module Data.Aviation.Aip.Ersa(
Ersa(..)
+, AsErsa(..)
+, FoldErsa(..)
+, GetErsa(..)
+, SetErsa(..)
+, ManyErsa(..)
, HasErsa(..)
+, IsErsa(..)
) where
-import Data.Aviation.Aip.AipHref(AipHref)
-import Data.Aviation.Aip.AipDate(AipDate)
-import Papa
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Aviation.Aip.ListItemLinks(ListItemLinks)
+import Data.Aviation.Aip.ErsaAerodromes(ErsaAerodromes)
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
data Ersa =
- Ersa {
- _ersaHref ::
- AipHref
- , _ersaDate ::
- AipDate
- } deriving (Eq, Ord, Show)
-
-makeClassy ''Ersa
+ Ersa
+ ListItemLinks
+ ErsaAerodromes
+ [Href] -- complete ERSA
+ deriving (Eq, Ord, Show)
+
+instance Semigroup Ersa where
+ Ersa l1 a1 c1 <> Ersa l2 a2 c2 =
+ Ersa (l1 <> l2) (a1 <> a2) (c1 <> c2)
+
+instance Monoid Ersa where
+ mappend =
+ (<>)
+ mempty =
+ Ersa mempty mempty mempty
+
+instance FromJSON Ersa where
+ parseJSON =
+ withObject "Ersa" $ \v ->
+ Ersa <$>
+ v .: "links" <*>
+ v .: "aerodromes" <*>
+ v .: "complete"
+
+instance ToJSON Ersa where
+ toJSON (Ersa links aerodromes complete) =
+ object ["links" .= links, "aerodromes" .= aerodromes, "complete" .= complete]
+
+class ManyErsa a => AsErsa a where
+ _Ersa ::
+ Prism' a Ersa
+ default _Ersa ::
+ IsErsa a =>
+ Prism' a Ersa
+ _Ersa =
+ _IsErsa
+
+instance AsErsa Ersa where
+ _Ersa =
+ id
+
+class FoldErsa a where
+ _FoldErsa ::
+ Fold a Ersa
+
+instance FoldErsa Ersa where
+ _FoldErsa =
+ id
+
+class FoldErsa a => GetErsa a where
+ _GetErsa ::
+ Getter a Ersa
+ default _GetErsa ::
+ HasErsa a =>
+ Getter a Ersa
+ _GetErsa =
+ ersa
+
+instance GetErsa Ersa where
+ _GetErsa =
+ id
+
+class SetErsa a where
+ _SetErsa ::
+ Setter' a Ersa
+ default _SetErsa ::
+ ManyErsa a =>
+ Setter' a Ersa
+ _SetErsa =
+ _ManyErsa
+
+instance SetErsa Ersa where
+ _SetErsa =
+ id
+
+class (FoldErsa a, SetErsa a) => ManyErsa a where
+ _ManyErsa ::
+ Traversal' a Ersa
+
+instance ManyErsa Ersa where
+ _ManyErsa =
+ id
+
+class (GetErsa a, ManyErsa a) => HasErsa a where
+ ersa ::
+ Lens' a Ersa
+ default ersa ::
+ IsErsa a =>
+ Lens' a Ersa
+ ersa =
+ _IsErsa
+
+instance HasErsa Ersa where
+ ersa =
+ id
+
+class (HasErsa a, AsErsa a) => IsErsa a where
+ _IsErsa ::
+ Iso' a Ersa
+
+instance IsErsa Ersa where
+ _IsErsa =
+ id
+
+instance SetErsa () where
+instance FoldErsa () where
+ _FoldErsa =
+ _ManyErsa
+instance ManyErsa () where
+ _ManyErsa _ x =
+ pure x
+
+----
+
+instance SetHref Ersa where
+instance FoldHref Ersa where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref Ersa where
+ _ManyHref f (Ersa l a c) =
+ Ersa <$> _ManyHref f l <*> _ManyHref f a <*> traverse f c
diff --git a/src/Data/Aviation/Aip/ErsaAerodrome.hs b/src/Data/Aviation/Aip/ErsaAerodrome.hs
new file mode 100644
index 0000000..0d6cbb3
--- /dev/null
+++ b/src/Data/Aviation/Aip/ErsaAerodrome.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.ErsaAerodrome(
+ ErsaAerodrome(..)
+, AsErsaAerodrome(..)
+, FoldErsaAerodrome(..)
+, GetErsaAerodrome(..)
+, SetErsaAerodrome(..)
+, ManyErsaAerodrome(..)
+, HasErsaAerodrome(..)
+, IsErsaAerodrome(..)
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Ord(Ord)
+import Data.Maybe(Maybe)
+import Data.String(String)
+import Prelude(Show)
+
+data ErsaAerodrome =
+ ErsaAerodrome
+ String
+ Href
+ (Maybe Href)
+ deriving (Eq, Ord, Show)
+
+instance FromJSON ErsaAerodrome where
+ parseJSON =
+ withObject "ErsaAerodrome" $ \v ->
+ ErsaAerodrome <$>
+ v .: "aerodrome" <*>
+ v .: "fac_href" <*>
+ v .: "rds_href"
+
+instance ToJSON ErsaAerodrome where
+ toJSON (ErsaAerodrome aerodrome fac rds) =
+ object ["aerodrome" .= aerodrome, "fac_href" .= fac, "rds_href" .= rds]
+
+class ManyErsaAerodrome a => AsErsaAerodrome a where
+ _ErsaAerodrome ::
+ Prism' a ErsaAerodrome
+ default _ErsaAerodrome ::
+ IsErsaAerodrome a =>
+ Prism' a ErsaAerodrome
+ _ErsaAerodrome =
+ _IsErsaAerodrome
+
+instance AsErsaAerodrome ErsaAerodrome where
+ _ErsaAerodrome =
+ id
+
+class FoldErsaAerodrome a where
+ _FoldErsaAerodrome ::
+ Fold a ErsaAerodrome
+
+instance FoldErsaAerodrome ErsaAerodrome where
+ _FoldErsaAerodrome =
+ id
+
+class FoldErsaAerodrome a => GetErsaAerodrome a where
+ _GetErsaAerodrome ::
+ Getter a ErsaAerodrome
+ default _GetErsaAerodrome ::
+ HasErsaAerodrome a =>
+ Getter a ErsaAerodrome
+ _GetErsaAerodrome =
+ ersaAerodrome
+
+instance GetErsaAerodrome ErsaAerodrome where
+ _GetErsaAerodrome =
+ id
+
+class SetErsaAerodrome a where
+ _SetErsaAerodrome ::
+ Setter' a ErsaAerodrome
+ default _SetErsaAerodrome ::
+ ManyErsaAerodrome a =>
+ Setter' a ErsaAerodrome
+ _SetErsaAerodrome =
+ _ManyErsaAerodrome
+
+instance SetErsaAerodrome ErsaAerodrome where
+ _SetErsaAerodrome =
+ id
+
+class (FoldErsaAerodrome a, SetErsaAerodrome a) => ManyErsaAerodrome a where
+ _ManyErsaAerodrome ::
+ Traversal' a ErsaAerodrome
+
+instance ManyErsaAerodrome ErsaAerodrome where
+ _ManyErsaAerodrome =
+ id
+
+class (GetErsaAerodrome a, ManyErsaAerodrome a) => HasErsaAerodrome a where
+ ersaAerodrome ::
+ Lens' a ErsaAerodrome
+ default ersaAerodrome ::
+ IsErsaAerodrome a =>
+ Lens' a ErsaAerodrome
+ ersaAerodrome =
+ _IsErsaAerodrome
+
+instance HasErsaAerodrome ErsaAerodrome where
+ ersaAerodrome =
+ id
+
+class (HasErsaAerodrome a, AsErsaAerodrome a) => IsErsaAerodrome a where
+ _IsErsaAerodrome ::
+ Iso' a ErsaAerodrome
+
+instance IsErsaAerodrome ErsaAerodrome where
+ _IsErsaAerodrome =
+ id
+
+instance SetErsaAerodrome () where
+instance FoldErsaAerodrome () where
+ _FoldErsaAerodrome =
+ _ManyErsaAerodrome
+instance ManyErsaAerodrome () where
+ _ManyErsaAerodrome _ x =
+ pure x
+
+----
+
+instance SetHref ErsaAerodrome where
+instance FoldHref ErsaAerodrome where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref ErsaAerodrome where
+ _ManyHref f (ErsaAerodrome aerodrome fac rds) =
+ ErsaAerodrome <$> pure aerodrome <*> f fac <*> traverse f rds
+
diff --git a/src/Data/Aviation/Aip/ErsaAerodromes.hs b/src/Data/Aviation/Aip/ErsaAerodromes.hs
new file mode 100644
index 0000000..b1d31f1
--- /dev/null
+++ b/src/Data/Aviation/Aip/ErsaAerodromes.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Data.Aviation.Aip.ErsaAerodromes(
+ ErsaAerodromes(..)
+, AsErsaAerodromes(..)
+, FoldErsaAerodromes(..)
+, GetErsaAerodromes(..)
+, SetErsaAerodromes(..)
+, ManyErsaAerodromes(..)
+, HasErsaAerodromes(..)
+, IsErsaAerodromes(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+import Data.Aviation.Aip.ErsaAerodrome(ErsaAerodrome)
+import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+
+newtype ErsaAerodromes =
+ ErsaAerodromes
+ [ErsaAerodrome]
+ deriving (Eq, Ord, Show)
+
+instance Semigroup ErsaAerodromes where
+ ErsaAerodromes x <> ErsaAerodromes y =
+ ErsaAerodromes (x <> y)
+
+instance Monoid ErsaAerodromes where
+ mappend =
+ (<>)
+ mempty =
+ ErsaAerodromes []
+
+instance Wrapped ErsaAerodromes where
+ type Unwrapped ErsaAerodromes =
+ [ErsaAerodrome]
+ _Wrapped' =
+ iso (\(ErsaAerodromes x) -> x) ErsaAerodromes
+
+instance ErsaAerodromes ~ x =>
+ Rewrapped ErsaAerodromes x
+
+instance FromJSON ErsaAerodromes where
+ parseJSON =
+ withArray "ErsaAerodromes" $ \v ->
+ ErsaAerodromes <$> traverse parseJSON (toList v)
+
+instance ToJSON ErsaAerodromes where
+ toJSON (ErsaAerodromes x) =
+ toJSON x
+
+instance Cons ErsaAerodromes ErsaAerodromes ErsaAerodrome ErsaAerodrome where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc ErsaAerodromes ErsaAerodromes ErsaAerodrome ErsaAerodrome where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each ErsaAerodromes ErsaAerodromes ErsaAerodrome ErsaAerodrome where
+ each =
+ _Wrapped . each
+
+instance Reversing ErsaAerodromes where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated ErsaAerodromes where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue ErsaAerodromes = ErsaAerodrome
+type instance Index ErsaAerodromes = Int
+instance Ixed ErsaAerodromes where
+ ix i =
+ _Wrapped . ix i
+
+class ManyErsaAerodromes a => AsErsaAerodromes a where
+ _ErsaAerodromes ::
+ Prism' a ErsaAerodromes
+ default _ErsaAerodromes ::
+ IsErsaAerodromes a =>
+ Prism' a ErsaAerodromes
+ _ErsaAerodromes =
+ _IsErsaAerodromes
+
+instance AsErsaAerodromes ErsaAerodromes where
+ _ErsaAerodromes =
+ id
+
+class FoldErsaAerodromes a where
+ _FoldErsaAerodromes ::
+ Fold a ErsaAerodromes
+
+instance FoldErsaAerodromes ErsaAerodromes where
+ _FoldErsaAerodromes =
+ id
+
+class FoldErsaAerodromes a => GetErsaAerodromes a where
+ _GetErsaAerodromes ::
+ Getter a ErsaAerodromes
+ default _GetErsaAerodromes ::
+ HasErsaAerodromes a =>
+ Getter a ErsaAerodromes
+ _GetErsaAerodromes =
+ ersaAerodromes
+
+instance GetErsaAerodromes ErsaAerodromes where
+ _GetErsaAerodromes =
+ id
+
+class SetErsaAerodromes a where
+ _SetErsaAerodromes ::
+ Setter' a ErsaAerodromes
+ default _SetErsaAerodromes ::
+ ManyErsaAerodromes a =>
+ Setter' a ErsaAerodromes
+ _SetErsaAerodromes =
+ _ManyErsaAerodromes
+
+instance SetErsaAerodromes ErsaAerodromes where
+ _SetErsaAerodromes =
+ id
+
+class (FoldErsaAerodromes a, SetErsaAerodromes a) => ManyErsaAerodromes a where
+ _ManyErsaAerodromes ::
+ Traversal' a ErsaAerodromes
+
+instance ManyErsaAerodromes ErsaAerodromes where
+ _ManyErsaAerodromes =
+ id
+
+class (GetErsaAerodromes a, ManyErsaAerodromes a) => HasErsaAerodromes a where
+ ersaAerodromes ::
+ Lens' a ErsaAerodromes
+ default ersaAerodromes ::
+ IsErsaAerodromes a =>
+ Lens' a ErsaAerodromes
+ ersaAerodromes =
+ _IsErsaAerodromes
+
+instance HasErsaAerodromes ErsaAerodromes where
+ ersaAerodromes =
+ id
+
+class (HasErsaAerodromes a, AsErsaAerodromes a) => IsErsaAerodromes a where
+ _IsErsaAerodromes ::
+ Iso' a ErsaAerodromes
+
+instance IsErsaAerodromes ErsaAerodromes where
+ _IsErsaAerodromes =
+ id
+
+instance SetErsaAerodromes () where
+instance FoldErsaAerodromes () where
+ _FoldErsaAerodromes =
+ _ManyErsaAerodromes
+instance ManyErsaAerodromes () where
+ _ManyErsaAerodromes _ x =
+ pure x
+
+----
+
+instance SetHref ErsaAerodromes where
+instance FoldHref ErsaAerodromes where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref ErsaAerodromes where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/Ersas.hs b/src/Data/Aviation/Aip/Ersas.hs
deleted file mode 100644
index 6ded4d5..0000000
--- a/src/Data/Aviation/Aip/Ersas.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Data.Aviation.Aip.Ersas(
- Ersas(..)
-, parseAipTree
-) where
-
-import Data.Aviation.Aip.Ersa(Ersa(Ersa))
-import Data.Aviation.Aip.AipDate(parseAipDate)
-import Data.Aviation.Aip.AipHref(parseAipHref)
-import Text.HTML.TagSoup(Tag(TagText))
-import Text.HTML.TagSoup.Tree(TagTree(TagBranch, TagLeaf), parseTree)
-import Text.HTML.TagSoup.Tree.Util(htmlRoot)
-import Text.HTML.TagSoup.Tree.Zipper(TagTreePos(TagTreePos), traverseTree, fromTagTree)
-import Text.Parsec(Parsec, Stream, parse)
-import Text.Parser.Char(space, char)
-import Text.Parser.Combinators(between)
-import Papa
-
-newtype Ersas =
- Ersas
- [Ersa]
- deriving (Eq, Ord, Show)
-
-makeWrapped ''Ersas
-
-instance Monoid Ersas where
- mempty =
- Ersas
- mempty
- Ersas x `mappend` Ersas y =
- Ersas (x `mappend` y)
-
-parseAipTree ::
- String
- -> Ersas
-parseAipTree =
- let runParse ::
- Stream s Identity t =>
- Parsec s () a
- -> s
- -> Maybe a
- runParse p s =
- parse p "aip" s ^? _Right
- aipTreeTraversal ::
- TagTreePos String
- -> Ersas
- aipTreeTraversal t =
- case t of
- TagTreePos (TagBranch "li" [] (TagBranch "a" [("href", href)] [TagLeaf (TagText n)]:TagLeaf (TagText tx):_)) _ _ _ ->
- let pdate = do _ <- space
- between (char '(') (char ')') parseAipDate
- in case n of
- "En Route Supplement Australia (ERSA)" ->
- let p = do h <- runParse parseAipHref href
- d <- runParse pdate tx
- pure (Ersas [Ersa h d])
- in fromMaybe mempty p
- _ ->
- mempty
- _ ->
- mempty
- in traverseTree aipTreeTraversal . fromTagTree . htmlRoot . parseTree
diff --git a/src/Data/Aviation/Aip/Href.hs b/src/Data/Aviation/Aip/Href.hs
new file mode 100644
index 0000000..8c648e2
--- /dev/null
+++ b/src/Data/Aviation/Aip/Href.hs
@@ -0,0 +1,222 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Href(
+ Href(..)
+, AsHref(..)
+, FoldHref(..)
+, GetHref(..)
+, SetHref(..)
+, ManyHref(..)
+, HasHref(..)
+, IsHref(..)
+, dropHrefFile
+, aipPrefix
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Bool(bool)
+import Data.Char(Char)
+import Data.Eq(Eq((/=)))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.List(reverse, dropWhile, isPrefixOf)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+newtype Href =
+ Href
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON Href where
+ parseJSON v =
+ Href <$> parseJSON v
+
+instance ToJSON Href where
+ toJSON (Href x) =
+ toJSON x
+
+instance Semigroup Href where
+ Href x <> Href y =
+ Href (x <> y)
+
+instance Monoid Href where
+ mappend =
+ (<>)
+ mempty =
+ Href mempty
+
+instance Cons Href Href Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc Href Href Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each Href Href Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing Href where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated Href where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue Href = Char
+type instance Index Href = Int
+instance Ixed Href where
+ ix i =
+ _Wrapped . ix i
+
+instance AsEmpty Href where
+ _Empty =
+ _Wrapped . _Empty
+
+instance Wrapped Href where
+ type Unwrapped Href = String
+ _Wrapped' =
+ iso
+ (\(Href x) -> x)
+ Href
+
+instance Href ~ a =>
+ Rewrapped Href a
+
+class ManyHref a => AsHref a where
+ _Href ::
+ Prism' a Href
+ default _Href ::
+ IsHref a =>
+ Prism' a Href
+ _Href =
+ _IsHref
+
+instance AsHref Href where
+ _Href =
+ id
+
+instance AsHref String where
+ _Href =
+ from _Wrapped
+
+class FoldHref a where
+ _FoldHref ::
+ Fold a Href
+
+instance FoldHref Href where
+ _FoldHref =
+ id
+
+instance FoldHref String where
+ _FoldHref =
+ from _Wrapped
+
+class FoldHref a => GetHref a where
+ _GetHref ::
+ Getter a Href
+ default _GetHref ::
+ HasHref a =>
+ Getter a Href
+ _GetHref =
+ href
+
+instance GetHref Href where
+ _GetHref =
+ id
+
+instance GetHref String where
+ _GetHref =
+ from _Wrapped
+
+class SetHref a where
+ _SetHref ::
+ Setter' a Href
+ default _SetHref ::
+ ManyHref a =>
+ Traversal' a Href
+ _SetHref =
+ _ManyHref
+
+instance SetHref Href where
+ _SetHref =
+ id
+
+instance SetHref String where
+ _SetHref =
+ from _Wrapped
+
+class (FoldHref a, SetHref a) => ManyHref a where
+ _ManyHref ::
+ Traversal' a Href
+
+instance ManyHref Href where
+ _ManyHref =
+ id
+
+instance ManyHref String where
+ _ManyHref =
+ from _Wrapped
+
+class (GetHref a, ManyHref a) => HasHref a where
+ href ::
+ Lens' a Href
+ default href ::
+ IsHref a =>
+ Lens' a Href
+ href =
+ _IsHref
+
+instance HasHref Href where
+ href =
+ id
+
+instance HasHref String where
+ href =
+ from _Wrapped
+
+class (HasHref a, AsHref a) => IsHref a where
+ _IsHref ::
+ Iso' a Href
+
+instance IsHref Href where
+ _IsHref =
+ id
+
+instance IsHref String where
+ _IsHref =
+ from _Wrapped
+
+instance SetHref () where
+instance FoldHref () where
+ _FoldHref =
+ _ManyHref
+instance ManyHref () where
+ _ManyHref _ x =
+ pure x
+
+dropHrefFile ::
+ Href
+ -> Href
+dropHrefFile =
+ (_Wrapped %~ reverse . dropWhile (/= '/') . reverse)
+
+aipPrefix ::
+ ManyHref s =>
+ s
+ -> s
+aipPrefix =
+ _ManyHref . _Wrapped %~ let p = "/aip/" in bool <$> (p <>) <*> id <*> isPrefixOf p
diff --git a/src/Data/Aviation/Aip/HttpRequest.hs b/src/Data/Aviation/Aip/HttpRequest.hs
index a3ecb82..378a1fd 100644
--- a/src/Data/Aviation/Aip/HttpRequest.hs
+++ b/src/Data/Aviation/Aip/HttpRequest.hs
@@ -1,23 +1,51 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP #-}
module Data.Aviation.Aip.HttpRequest(
aipRequestGet
, aipRequestPost
, aipRequestMethod
, doRequest
+, doRequest'
+, doGetRequest
+, doPostRequest
, requestAipContents
+, downloadHref
) where
-
+
+import Control.Category((.))
+import Control.Applicative(pure)
+import Control.Lens
+import Control.Monad.IO.Class(liftIO)
+import Network.HTTP(HandleStream, getAuth, openStream, host, normalizeRequest, defaultNormalizeRequestOptions, close)
+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.Log(aiplog)
import Data.Aviation.Aip.ConnErrorHttp4xx(ConnErrorHttp4xx(IsConnError, Http4xx))
-import Network.HTTP(HStream, Request, RequestMethod(GET, POST), mkRequest, setRequestBody, simpleHTTP, rspCode, rspBody)
+import Data.Aviation.Aip.Href(Href(Href))
+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.List(isPrefixOf, dropWhile)
+import Data.Maybe(Maybe(Just))
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Network.HTTP(HStream, Request, RequestMethod(GET, POST), mkRequest, setRequestBody, simpleHTTP, simpleHTTP_, rspCode, rspBody)
import Network.BufferType(BufferType)
import Network.URI(URI(URI), URIAuth(URIAuth))
-import Papa
+import Prelude(Show(show))
+import System.Directory(createDirectoryIfMissing)
+import System.FilePath(FilePath, splitFileName, isPathSeparator, (</>))
aipRequestGet ::
BufferType ty =>
- String
+ Href
-> String
-> Request ty
aipRequestGet =
@@ -25,7 +53,7 @@ aipRequestGet =
aipRequestPost ::
BufferType ty =>
- String
+ Href
-> String
-> Request ty
aipRequestPost =
@@ -34,33 +62,101 @@ aipRequestPost =
aipRequestMethod ::
BufferType ty =>
RequestMethod
- -> String
+ -> Href
-> String
-> Request ty
-aipRequestMethod m s z =
- mkRequest m (URI "http:" (Just (URIAuth "" "www.airservicesaustralia.com" "")) ("/aip/" ++ s) z "")
+aipRequestMethod m (Href s) z =
+ let s' = bool ("/aip/" <> s) s ("/aip/" `isPrefixOf` s)
+ in mkRequest m (URI "http:" (Just (URIAuth "" "www.airservicesaustralia.com" "")) s' z "")
doRequest ::
HStream a =>
Request a
- -> ExceptT ConnErrorHttp4xx IO a
+ -> AipCon a
doRequest r =
+ AipCon . pure .
ExceptT $
do x <- simpleHTTP r
- case x of
- Left e ->
- pure (Left (IsConnError e))
- Right c ->
- let (r1, r2, r3) = rspCode c
- in if r1 == 4 then
- pure (Left (Http4xx r2 r3))
- else
- pure (Right (rspBody c))
+ pure $
+ case x of
+ Left e ->
+ Left (IsConnError e)
+ Right c ->
+ let (r1, r2, r3) = rspCode c
+ in if r1 == 4 then
+ Left (Http4xx r2 r3)
+ else
+ Right (rspBody c)
+
+doRequest' ::
+ HStream a =>
+ Request a
+ -> HandleStream a
+ -> AipCon a
+doRequest' r h =
+ AipCon . pure .
+ ExceptT $
+ do x <- simpleHTTP_ h r
+ pure $
+ case x of
+ Left e ->
+ Left (IsConnError e)
+ Right c ->
+ let (r1, r2, r3) = rspCode c
+ in if r1 == 4 then
+ Left (Http4xx r2 r3)
+ else
+ Right (rspBody c)
+
+doGetRequest ::
+ HStream a =>
+ Href
+ -> String
+ -> AipCon a
+doGetRequest s z =
+ doRequest (aipRequestGet s z)
+
+doPostRequest ::
+ HStream a =>
+ Href
+ -> String
+ -> AipCon a
+doPostRequest s z =
+ doRequest (aipRequestPost s z)
requestAipContents ::
- ExceptT ConnErrorHttp4xx IO String
+ AipCon String
requestAipContents =
let r = setRequestBody
- (aipRequestPost "aip.asp" "?pg=10")
+ (aipRequestPost (Href "aip.asp") "?pg=10")
("application/x-www-form-urlencoded", "Submit=I+Agree&check=1")
in doRequest r
+
+downloadHref ::
+ FilePath
+ -> Href
+ -> AipCon FilePath
+downloadHref d hf =
+ do let q = aipRequestGet hf ""
+ aiplog ("making request for aip document " <> show q)
+ auth <- getAuth q
+ aiplog ("making request for aip document with auth " <> show auth)
+ c <- liftIO $ openStream (host auth) 80
+ r <- doRequest' (normalizeRequest defaultNormalizeRequestOptions q) c
+ let (j, k) = splitFileName (hf ^. _Wrapped)
+ 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
+ aiplog ("writing aip document " <> otw)
+ liftIO $ LazyByteString.writeFile otw r
+ liftIO $ close c
+ pure ot'
diff --git a/src/Data/Aviation/Aip/ListItemLink.hs b/src/Data/Aviation/Aip/ListItemLink.hs
new file mode 100644
index 0000000..0cfb910
--- /dev/null
+++ b/src/Data/Aviation/Aip/ListItemLink.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.ListItemLink(
+ ListItemLink(..)
+, AsListItemLink(..)
+, FoldListItemLink(..)
+, GetListItemLink(..)
+, SetListItemLink(..)
+, ManyListItemLink(..)
+, HasListItemLink(..)
+, IsListItemLink(..)
+) where
+
+import Control.Category(id)
+import Control.Applicative(pure, (<*>))
+import Control.Lens hiding ((.=))
+import Data.Aviation.Aip.Href(Href, SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref), GetHref, HasHref(href))
+import Data.Aviation.Aip.Txt(Txt)
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withObject, object, (.:), (.=))
+import Data.Eq(Eq)
+import Data.Function(($))
+import Data.Functor(fmap, (<$>))
+import Data.Ord(Ord)
+import Prelude(Show)
+
+data ListItemLink =
+ ListItemLink
+ Href
+ Txt
+ deriving (Eq, Ord, Show)
+
+instance FromJSON ListItemLink where
+ parseJSON =
+ withObject "ListItemLink" $ \v ->
+ ListItemLink <$>
+ v .: "href" <*>
+ v .: "txt"
+
+instance ToJSON ListItemLink where
+ toJSON (ListItemLink u t) =
+ object ["href" .= u, "txt" .= t]
+
+class ManyListItemLink a => AsListItemLink a where
+ _ListItemLink ::
+ Prism' a ListItemLink
+ default _ListItemLink ::
+ IsListItemLink a =>
+ Prism' a ListItemLink
+ _ListItemLink =
+ _IsListItemLink
+
+instance AsListItemLink ListItemLink where
+ _ListItemLink =
+ id
+
+class FoldListItemLink a where
+ _FoldListItemLink ::
+ Fold a ListItemLink
+
+instance FoldListItemLink ListItemLink where
+ _FoldListItemLink =
+ id
+
+class FoldListItemLink a => GetListItemLink a where
+ _GetListItemLink ::
+ Getter a ListItemLink
+ default _GetListItemLink ::
+ HasListItemLink a =>
+ Getter a ListItemLink
+ _GetListItemLink =
+ listItemLink
+
+instance GetListItemLink ListItemLink where
+ _GetListItemLink =
+ id
+
+class SetListItemLink a where
+ _SetListItemLink ::
+ Setter' a ListItemLink
+ default _SetListItemLink ::
+ ManyListItemLink a =>
+ Setter' a ListItemLink
+ _SetListItemLink =
+ _ManyListItemLink
+
+instance SetListItemLink ListItemLink where
+ _SetListItemLink =
+ id
+
+class (FoldListItemLink a, SetListItemLink a) => ManyListItemLink a where
+ _ManyListItemLink ::
+ Traversal' a ListItemLink
+
+instance ManyListItemLink ListItemLink where
+ _ManyListItemLink =
+ id
+
+class (GetListItemLink a, ManyListItemLink a) => HasListItemLink a where
+ listItemLink ::
+ Lens' a ListItemLink
+ default listItemLink ::
+ IsListItemLink a =>
+ Lens' a ListItemLink
+ listItemLink =
+ _IsListItemLink
+
+instance HasListItemLink ListItemLink where
+ listItemLink =
+ id
+
+class (HasListItemLink a, AsListItemLink a) => IsListItemLink a where
+ _IsListItemLink ::
+ Iso' a ListItemLink
+
+instance IsListItemLink ListItemLink where
+ _IsListItemLink =
+ id
+
+instance SetListItemLink () where
+instance FoldListItemLink () where
+ _FoldListItemLink =
+ _ManyListItemLink
+instance ManyListItemLink () where
+ _ManyListItemLink _ x =
+ pure x
+
+----
+
+instance SetHref ListItemLink where
+instance FoldHref ListItemLink where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref ListItemLink where
+ _ManyHref f (ListItemLink u x) =
+ ListItemLink <$> f u <*> pure x
+
+instance GetHref ListItemLink where
+instance HasHref ListItemLink where
+ href f (ListItemLink u x) =
+ fmap (\u' -> ListItemLink u' x) (f u)
diff --git a/src/Data/Aviation/Aip/ListItemLinks.hs b/src/Data/Aviation/Aip/ListItemLinks.hs
new file mode 100644
index 0000000..9940e59
--- /dev/null
+++ b/src/Data/Aviation/Aip/ListItemLinks.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.ListItemLinks(
+ ListItemLinks(..)
+, AsListItemLinks(..)
+, FoldListItemLinks(..)
+, GetListItemLinks(..)
+, SetListItemLinks(..)
+, ManyListItemLinks(..)
+, HasListItemLinks(..)
+, IsListItemLinks(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.Href(SetHref, FoldHref, ManyHref(_ManyHref), FoldHref(_FoldHref))
+import Data.Aviation.Aip.ListItemLink(ListItemLink, ManyListItemLink(_ManyListItemLink), SetListItemLink, FoldListItemLink(_FoldListItemLink))
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+
+newtype ListItemLinks =
+ ListItemLinks
+ [ListItemLink]
+ deriving (Eq, Ord, Show)
+
+instance FromJSON ListItemLinks where
+ parseJSON =
+ withArray "ListItemLinks" $ \v ->
+ ListItemLinks <$> traverse parseJSON (toList v)
+
+instance ToJSON ListItemLinks where
+ toJSON (ListItemLinks x) =
+ toJSON x
+
+instance Semigroup ListItemLinks where
+ ListItemLinks x <> ListItemLinks y =
+ ListItemLinks (x <> y)
+
+instance Monoid ListItemLinks where
+ mappend =
+ (<>)
+ mempty =
+ ListItemLinks []
+
+instance Wrapped ListItemLinks where
+ type Unwrapped ListItemLinks =
+ [ListItemLink]
+ _Wrapped' =
+ iso (\(ListItemLinks x) -> x) ListItemLinks
+
+instance ListItemLinks ~ x =>
+ Rewrapped ListItemLinks x
+
+instance Cons ListItemLinks ListItemLinks ListItemLink ListItemLink where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc ListItemLinks ListItemLinks ListItemLink ListItemLink where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each ListItemLinks ListItemLinks ListItemLink ListItemLink where
+ each =
+ _Wrapped . each
+
+instance Reversing ListItemLinks where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated ListItemLinks where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue ListItemLinks = ListItemLink
+type instance Index ListItemLinks = Int
+instance Ixed ListItemLinks where
+ ix i =
+ _Wrapped . ix i
+
+class ManyListItemLinks a => AsListItemLinks a where
+ _ListItemLinks ::
+ Prism' a ListItemLinks
+ default _ListItemLinks ::
+ IsListItemLinks a =>
+ Prism' a ListItemLinks
+ _ListItemLinks =
+ _IsListItemLinks
+
+instance AsListItemLinks ListItemLinks where
+ _ListItemLinks =
+ id
+
+class FoldListItemLinks a where
+ _FoldListItemLinks ::
+ Fold a ListItemLinks
+
+instance FoldListItemLinks ListItemLinks where
+ _FoldListItemLinks =
+ id
+
+class FoldListItemLinks a => GetListItemLinks a where
+ _GetListItemLinks ::
+ Getter a ListItemLinks
+ default _GetListItemLinks ::
+ HasListItemLinks a =>
+ Getter a ListItemLinks
+ _GetListItemLinks =
+ listItemLinks
+
+instance GetListItemLinks ListItemLinks where
+ _GetListItemLinks =
+ id
+
+class SetListItemLinks a where
+ _SetListItemLinks ::
+ Setter' a ListItemLinks
+ default _SetListItemLinks ::
+ ManyListItemLinks a =>
+ Setter' a ListItemLinks
+ _SetListItemLinks =
+ _ManyListItemLinks
+
+instance SetListItemLinks ListItemLinks where
+ _SetListItemLinks =
+ id
+
+class (FoldListItemLinks a, SetListItemLinks a) => ManyListItemLinks a where
+ _ManyListItemLinks ::
+ Traversal' a ListItemLinks
+
+instance ManyListItemLinks ListItemLinks where
+ _ManyListItemLinks =
+ id
+
+class (GetListItemLinks a, ManyListItemLinks a) => HasListItemLinks a where
+ listItemLinks ::
+ Lens' a ListItemLinks
+ default listItemLinks ::
+ IsListItemLinks a =>
+ Lens' a ListItemLinks
+ listItemLinks =
+ _IsListItemLinks
+
+instance HasListItemLinks ListItemLinks where
+ listItemLinks =
+ id
+
+class (HasListItemLinks a, AsListItemLinks a) => IsListItemLinks a where
+ _IsListItemLinks ::
+ Iso' a ListItemLinks
+
+instance IsListItemLinks ListItemLinks where
+ _IsListItemLinks =
+ id
+
+instance SetListItemLinks () where
+instance FoldListItemLinks () where
+ _FoldListItemLinks =
+ _ManyListItemLinks
+instance ManyListItemLinks () where
+ _ManyListItemLinks _ x =
+ pure x
+
+----
+
+instance SetListItemLink ListItemLinks where
+
+instance FoldListItemLink ListItemLinks where
+ _FoldListItemLink =
+ _ManyListItemLink
+
+instance ManyListItemLink ListItemLinks where
+ _ManyListItemLink f (ListItemLinks x) =
+ ListItemLinks <$> traverse f x
+
+instance SetHref ListItemLinks where
+instance FoldHref ListItemLinks where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref ListItemLinks where
+ _ManyHref =
+ _Wrapped . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/ListItemLinks1.hs b/src/Data/Aviation/Aip/ListItemLinks1.hs
new file mode 100644
index 0000000..c7101d1
--- /dev/null
+++ b/src/Data/Aviation/Aip/ListItemLinks1.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Aviation.Aip.ListItemLinks1(
+ ListItemLinks1(..)
+, AsListItemLinks1(..)
+, FoldListItemLinks1(..)
+, GetListItemLinks1(..)
+, SetListItemLinks1(..)
+, ManyListItemLinks1(..)
+, HasListItemLinks1(..)
+, IsListItemLinks1(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), withArray)
+import Data.Aviation.Aip.Href(SetHref, FoldHref(_FoldHref), ManyHref(_ManyHref))
+import Data.Aviation.Aip.ListItemLink(ListItemLink)
+import Data.Eq(Eq)
+import Data.Foldable(toList)
+import Data.Function(($))
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.List.NonEmpty(NonEmpty)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Prelude(Show)
+
+newtype ListItemLinks1 =
+ ListItemLinks1
+ [NonEmpty ListItemLink]
+ deriving (Eq, Ord, Show)
+
+instance Semigroup ListItemLinks1 where
+ ListItemLinks1 x <> ListItemLinks1 y =
+ ListItemLinks1 (x <> y)
+
+instance Monoid ListItemLinks1 where
+ mappend =
+ (<>)
+ mempty =
+ ListItemLinks1 mempty
+
+instance FromJSON ListItemLinks1 where
+ parseJSON =
+ withArray "ListItemLinks1" $ \v ->
+ ListItemLinks1 <$> traverse parseJSON (toList v)
+
+instance ToJSON ListItemLinks1 where
+ toJSON (ListItemLinks1 x) =
+ toJSON x
+
+instance Wrapped ListItemLinks1 where
+ type Unwrapped ListItemLinks1 =
+ [NonEmpty ListItemLink]
+ _Wrapped' =
+ iso (\(ListItemLinks1 x) -> x) ListItemLinks1
+
+instance ListItemLinks1 ~ x =>
+ Rewrapped ListItemLinks1 x
+
+instance Cons ListItemLinks1 ListItemLinks1 (NonEmpty ListItemLink) (NonEmpty ListItemLink) where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc ListItemLinks1 ListItemLinks1 (NonEmpty ListItemLink) (NonEmpty ListItemLink) where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each ListItemLinks1 ListItemLinks1 (NonEmpty ListItemLink) (NonEmpty ListItemLink) where
+ each =
+ _Wrapped . each
+
+instance Reversing ListItemLinks1 where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated ListItemLinks1 where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue ListItemLinks1 = NonEmpty ListItemLink
+type instance Index ListItemLinks1 = Int
+instance Ixed ListItemLinks1 where
+ ix i =
+ _Wrapped . ix i
+
+class ManyListItemLinks1 a => AsListItemLinks1 a where
+ _ListItemLinks1 ::
+ Prism' a ListItemLinks1
+ default _ListItemLinks1 ::
+ IsListItemLinks1 a =>
+ Prism' a ListItemLinks1
+ _ListItemLinks1 =
+ _IsListItemLinks1
+
+instance AsListItemLinks1 ListItemLinks1 where
+ _ListItemLinks1 =
+ id
+
+class FoldListItemLinks1 a where
+ _FoldListItemLinks1 ::
+ Fold a ListItemLinks1
+
+instance FoldListItemLinks1 ListItemLinks1 where
+ _FoldListItemLinks1 =
+ id
+
+class FoldListItemLinks1 a => GetListItemLinks1 a where
+ _GetListItemLinks1 ::
+ Getter a ListItemLinks1
+ default _GetListItemLinks1 ::
+ HasListItemLinks1 a =>
+ Getter a ListItemLinks1
+ _GetListItemLinks1 =
+ listItemLinks1
+
+instance GetListItemLinks1 ListItemLinks1 where
+ _GetListItemLinks1 =
+ id
+
+class SetListItemLinks1 a where
+ _SetListItemLinks1 ::
+ Setter' a ListItemLinks1
+ default _SetListItemLinks1 ::
+ ManyListItemLinks1 a =>
+ Setter' a ListItemLinks1
+ _SetListItemLinks1 =
+ _ManyListItemLinks1
+
+instance SetListItemLinks1 ListItemLinks1 where
+ _SetListItemLinks1 =
+ id
+
+class (FoldListItemLinks1 a, SetListItemLinks1 a) => ManyListItemLinks1 a where
+ _ManyListItemLinks1 ::
+ Traversal' a ListItemLinks1
+
+instance ManyListItemLinks1 ListItemLinks1 where
+ _ManyListItemLinks1 =
+ id
+
+class (GetListItemLinks1 a, ManyListItemLinks1 a) => HasListItemLinks1 a where
+ listItemLinks1 ::
+ Lens' a ListItemLinks1
+ default listItemLinks1 ::
+ IsListItemLinks1 a =>
+ Lens' a ListItemLinks1
+ listItemLinks1 =
+ _IsListItemLinks1
+
+instance HasListItemLinks1 ListItemLinks1 where
+ listItemLinks1 =
+ id
+
+class (HasListItemLinks1 a, AsListItemLinks1 a) => IsListItemLinks1 a where
+ _IsListItemLinks1 ::
+ Iso' a ListItemLinks1
+
+instance IsListItemLinks1 ListItemLinks1 where
+ _IsListItemLinks1 =
+ id
+
+instance SetListItemLinks1 () where
+instance FoldListItemLinks1 () where
+ _FoldListItemLinks1 =
+ _ManyListItemLinks1
+instance ManyListItemLinks1 () where
+ _ManyListItemLinks1 _ x =
+ pure x
+
+instance SetHref ListItemLinks1 where
+instance FoldHref ListItemLinks1 where
+ _FoldHref =
+ _ManyHref
+
+instance ManyHref ListItemLinks1 where
+ _ManyHref =
+ _Wrapped . traverse . traverse . _ManyHref
diff --git a/src/Data/Aviation/Aip/Log.hs b/src/Data/Aviation/Aip/Log.hs
new file mode 100644
index 0000000..d386939
--- /dev/null
+++ b/src/Data/Aviation/Aip/Log.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Data.Aviation.Aip.Log(
+ aiplog
+, aiplog'
+) where
+
+import Control.Category((.))
+import Control.Monad.IO.Class(MonadIO(liftIO))
+import Data.String(String)
+import System.IO(hPutStrLn, stderr, IO)
+
+aiplog ::
+ MonadIO f =>
+ String
+ -> f ()
+aiplog =
+ liftIO . aiplog'
+
+aiplog' ::
+ String
+ -> IO ()
+aiplog' =
+ hPutStrLn stderr
diff --git a/src/Data/Aviation/Aip/Month.hs b/src/Data/Aviation/Aip/Month.hs
deleted file mode 100644
index 453a895..0000000
--- a/src/Data/Aviation/Aip/Month.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Data.Aviation.Aip.Month(
- Month(..)
-, parseMonth
-, HasMonth(..)
-, AsMonth(..)
-) where
-
-import Text.Parser.Combinators(choice, try)
-import Text.Parser.Char(CharParsing, string)
-import Papa
-
-data Month =
- Jan
- | Feb
- | Mar
- | Apr
- | May
- | Jun
- | Jul
- | Aug
- | Sep
- | Oct
- | Nov
- | Dec
- deriving (Eq, Ord, Show)
-
-parseMonth ::
- CharParsing p =>
- p Month
-parseMonth =
- choice
- [
- Jan <$ string "Jan"
- , Feb <$ try (string "Feb")
- , Mar <$ try (string "Mar")
- , Apr <$ try (string "Apr")
- , May <$ try (string "May")
- , Jun <$ try (string "Jun")
- , Jul <$ try (string "Jul")
- , Aug <$ try (string "Aug")
- , Sep <$ try (string "Sep")
- , Oct <$ try (string "Oct")
- , Nov <$ try (string "Nov")
- , Dec <$ try (string "Dec")
- ]
-
-makeClassy ''Month
-makeClassyPrisms ''Month
diff --git a/src/Data/Aviation/Aip/SHA1.hs b/src/Data/Aviation/Aip/SHA1.hs
new file mode 100644
index 0000000..4ee0891
--- /dev/null
+++ b/src/Data/Aviation/Aip/SHA1.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.SHA1(
+ SHA1(..)
+, AsSHA1(..)
+, FoldSHA1(..)
+, GetSHA1(..)
+, SetSHA1(..)
+, ManySHA1(..)
+, HasSHA1(..)
+, IsSHA1(..)
+, hash
+, hashHex
+, showsHash
+, showHash
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Digest.SHA1(Word160(Word160))
+import qualified Data.Digest.SHA1 as SHA1(hash, toInteger)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.String(String)
+import Data.Word(Word8)
+import Numeric(showHex)
+import Prelude(Show, ShowS)
+
+newtype SHA1 =
+ SHA1
+ Word160
+ deriving (Eq, Show)
+
+instance FromJSON SHA1 where
+ parseJSON v =
+ (\(b0, b1, b2, b3, b4) -> SHA1 (Word160 b0 b1 b2 b3 b4)) <$> parseJSON v
+
+instance ToJSON SHA1 where
+ toJSON (SHA1 (Word160 b0 b1 b2 b3 b4)) =
+ toJSON (b0, b1, b2, b3, b4)
+
+class ManySHA1 a => AsSHA1 a where
+ _SHA1 ::
+ Prism' a SHA1
+ default _SHA1 ::
+ IsSHA1 a =>
+ Prism' a SHA1
+ _SHA1 =
+ _IsSHA1
+
+instance AsSHA1 SHA1 where
+ _SHA1 =
+ id
+
+class FoldSHA1 a where
+ _FoldSHA1 ::
+ Fold a SHA1
+
+instance FoldSHA1 SHA1 where
+ _FoldSHA1 =
+ id
+
+class FoldSHA1 a => GetSHA1 a where
+ _GetSHA1 ::
+ Getter a SHA1
+ default _GetSHA1 ::
+ HasSHA1 a =>
+ Getter a SHA1
+ _GetSHA1 =
+ sha1
+
+instance GetSHA1 SHA1 where
+ _GetSHA1 =
+ id
+
+class SetSHA1 a where
+ _SetSHA1 ::
+ Setter' a SHA1
+ default _SetSHA1 ::
+ ManySHA1 a =>
+ Setter' a SHA1
+ _SetSHA1 =
+ _ManySHA1
+
+instance SetSHA1 SHA1 where
+ _SetSHA1 =
+ id
+
+class (FoldSHA1 a, SetSHA1 a) => ManySHA1 a where
+ _ManySHA1 ::
+ Traversal' a SHA1
+
+instance ManySHA1 SHA1 where
+ _ManySHA1 =
+ id
+
+class (GetSHA1 a, ManySHA1 a) => HasSHA1 a where
+ sha1 ::
+ Lens' a SHA1
+ default sha1 ::
+ IsSHA1 a =>
+ Lens' a SHA1
+ sha1 =
+ _IsSHA1
+
+instance HasSHA1 SHA1 where
+ sha1 =
+ id
+
+class (HasSHA1 a, AsSHA1 a) => IsSHA1 a where
+ _IsSHA1 ::
+ Iso' a SHA1
+
+instance IsSHA1 SHA1 where
+ _IsSHA1 =
+ id
+
+instance SetSHA1 () where
+instance FoldSHA1 () where
+ _FoldSHA1 =
+ _ManySHA1
+instance ManySHA1 () where
+ _ManySHA1 _ x =
+ pure x
+
+hash ::
+ [Word8]
+ -> SHA1
+hash =
+ SHA1 . SHA1.hash
+
+hashHex ::
+ SHA1
+ -> ShowS
+hashHex (SHA1 x) =
+ showHex (SHA1.toInteger x)
+
+showsHash ::
+ HasSHA1 s =>
+ s
+ -> ShowS
+showsHash x =
+ hashHex (x ^. sha1)
+
+showHash ::
+ HasSHA1 s =>
+ s
+ -> String
+showHash x =
+ showsHash x ""
diff --git a/src/Data/Aviation/Aip/Title.hs b/src/Data/Aviation/Aip/Title.hs
new file mode 100644
index 0000000..beab4c7
--- /dev/null
+++ b/src/Data/Aviation/Aip/Title.hs
@@ -0,0 +1,202 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Title(
+ Title(..)
+, AsTitle(..)
+, FoldTitle(..)
+, GetTitle(..)
+, SetTitle(..)
+, ManyTitle(..)
+, HasTitle(..)
+, IsTitle(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Char(Char)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+
+newtype Title =
+ Title
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON Title where
+ parseJSON v =
+ Title <$> parseJSON v
+
+instance ToJSON Title where
+ toJSON (Title x) =
+ toJSON x
+
+instance Semigroup Title where
+ Title x <> Title y =
+ Title (x <> y)
+
+instance Monoid Title where
+ mappend =
+ (<>)
+ mempty =
+ Title mempty
+
+instance Cons Title Title Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc Title Title Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each Title Title Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing Title where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated Title where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue Title = Char
+type instance Index Title = Int
+instance Ixed Title where
+ ix i =
+ _Wrapped . ix i
+
+instance Wrapped Title where
+ type Unwrapped Title = String
+ _Wrapped' =
+ iso
+ (\(Title x) -> x)
+ Title
+
+instance Title ~ a =>
+ Rewrapped Title a
+
+class ManyTitle a => AsTitle a where
+ _Title ::
+ Prism' a Title
+ default _Title ::
+ IsTitle a =>
+ Prism' a Title
+ _Title =
+ _IsTitle
+
+instance AsTitle Title where
+ _Title =
+ id
+
+instance AsTitle String where
+ _Title =
+ from _Wrapped
+
+class FoldTitle a where
+ _FoldTitle ::
+ Fold a Title
+
+instance FoldTitle Title where
+ _FoldTitle =
+ id
+
+instance FoldTitle String where
+ _FoldTitle =
+ from _Wrapped
+
+class FoldTitle a => GetTitle a where
+ _GetTitle ::
+ Getter a Title
+ default _GetTitle ::
+ HasTitle a =>
+ Getter a Title
+ _GetTitle =
+ title
+
+instance GetTitle Title where
+ _GetTitle =
+ id
+
+instance GetTitle String where
+ _GetTitle =
+ from _Wrapped
+
+class SetTitle a where
+ _SetTitle ::
+ Setter' a Title
+ default _SetTitle ::
+ ManyTitle a =>
+ Setter' a Title
+ _SetTitle =
+ _ManyTitle
+
+instance SetTitle Title where
+ _SetTitle =
+ id
+
+instance SetTitle String where
+ _SetTitle =
+ from _Wrapped
+
+class (FoldTitle a, SetTitle a) => ManyTitle a where
+ _ManyTitle ::
+ Traversal' a Title
+
+instance ManyTitle Title where
+ _ManyTitle =
+ id
+
+instance ManyTitle String where
+ _ManyTitle =
+ from _Wrapped
+
+class (GetTitle a, ManyTitle a) => HasTitle a where
+ title ::
+ Lens' a Title
+ default title ::
+ IsTitle a =>
+ Lens' a Title
+ title =
+ _IsTitle
+
+instance HasTitle Title where
+ title =
+ id
+
+instance HasTitle String where
+ title =
+ from _Wrapped
+
+class (HasTitle a, AsTitle a) => IsTitle a where
+ _IsTitle ::
+ Iso' a Title
+
+instance IsTitle Title where
+ _IsTitle =
+ id
+
+instance IsTitle String where
+ _IsTitle =
+ from _Wrapped
+
+instance SetTitle () where
+instance FoldTitle () where
+ _FoldTitle =
+ _ManyTitle
+instance ManyTitle () where
+ _ManyTitle _ x =
+ pure x
diff --git a/src/Data/Aviation/Aip/Txt.hs b/src/Data/Aviation/Aip/Txt.hs
new file mode 100644
index 0000000..96e47a9
--- /dev/null
+++ b/src/Data/Aviation/Aip/Txt.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Data.Aviation.Aip.Txt (
+ Txt(..)
+, AsTxt(..)
+, FoldTxt(..)
+, GetTxt(..)
+, SetTxt(..)
+, ManyTxt(..)
+, HasTxt(..)
+, IsTxt(..)
+) where
+
+import Control.Category((.), id)
+import Control.Applicative(pure)
+import Control.Lens
+import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON))
+import Data.Char(Char)
+import Data.Eq(Eq)
+import Data.Functor((<$>))
+import Data.Int(Int)
+import Data.Monoid(Monoid(mappend, mempty))
+import Data.Ord(Ord)
+import Data.Semigroup(Semigroup((<>)))
+import Data.String(String)
+import Prelude(Show)
+
+-- import Papa hiding ((.=))
+
+newtype Txt =
+ Txt
+ String
+ deriving (Eq, Ord, Show)
+
+instance FromJSON Txt where
+ parseJSON v =
+ Txt <$> parseJSON v
+
+instance ToJSON Txt where
+ toJSON (Txt x) =
+ toJSON x
+
+instance Semigroup Txt where
+ Txt x <> Txt y =
+ Txt (x <> y)
+
+instance Monoid Txt where
+ mappend =
+ (<>)
+ mempty =
+ Txt mempty
+
+instance Cons Txt Txt Char Char where
+ _Cons =
+ _Wrapped . _Cons . seconding (from _Wrapped)
+
+instance Snoc Txt Txt Char Char where
+ _Snoc =
+ _Wrapped . _Snoc . firsting (from _Wrapped)
+
+instance Each Txt Txt Char Char where
+ each =
+ _Wrapped . each
+
+instance Reversing Txt where
+ reversing =
+ _Wrapped %~ reversing
+
+instance Plated Txt where
+ plate =
+ _Wrapped . plate . from _Wrapped
+
+type instance IxValue Txt = Char
+type instance Index Txt = Int
+instance Ixed Txt where
+ ix i =
+ _Wrapped . ix i
+
+instance AsEmpty Txt where
+ _Empty =
+ _Wrapped . _Empty
+
+instance Wrapped Txt where
+ type Unwrapped Txt = String
+ _Wrapped' =
+ iso
+ (\(Txt x) -> x)
+ Txt
+
+instance Txt ~ a =>
+ Rewrapped Txt a
+
+class ManyTxt a => AsTxt a where
+ _Txt ::
+ Prism' a Txt
+ default _Txt ::
+ IsTxt a =>
+ Prism' a Txt
+ _Txt =
+ _IsTxt
+
+instance AsTxt Txt where
+ _Txt =
+ id
+
+instance AsTxt String where
+ _Txt =
+ from _Wrapped
+
+class FoldTxt a where
+ _FoldTxt ::
+ Fold a Txt
+
+instance FoldTxt Txt where
+ _FoldTxt =
+ id
+
+instance FoldTxt String where
+ _FoldTxt =
+ from _Wrapped
+
+class FoldTxt a => GetTxt a where
+ _GetTxt ::
+ Getter a Txt
+ default _GetTxt ::
+ HasTxt a =>
+ Getter a Txt
+ _GetTxt =
+ txt
+
+instance GetTxt Txt where
+ _GetTxt =
+ id
+
+instance GetTxt String where
+ _GetTxt =
+ from _Wrapped
+
+class SetTxt a where
+ _SetTxt ::
+ Setter' a Txt
+ default _SetTxt ::
+ ManyTxt a =>
+ Traversal' a Txt
+ _SetTxt =
+ _ManyTxt
+
+instance SetTxt Txt where
+ _SetTxt =
+ id
+
+instance SetTxt String where
+ _SetTxt =
+ from _Wrapped
+
+class (FoldTxt a, SetTxt a) => ManyTxt a where
+ _ManyTxt ::
+ Traversal' a Txt
+
+instance ManyTxt Txt where
+ _ManyTxt =
+ id
+
+instance ManyTxt String where
+ _ManyTxt =
+ from _Wrapped
+
+class (GetTxt a, ManyTxt a) => HasTxt a where
+ txt ::
+ Lens' a Txt
+ default txt ::
+ IsTxt a =>
+ Lens' a Txt
+ txt =
+ _IsTxt
+
+instance HasTxt Txt where
+ txt =
+ id
+
+instance HasTxt String where
+ txt =
+ from _Wrapped
+
+class (HasTxt a, AsTxt a) => IsTxt a where
+ _IsTxt ::
+ Iso' a Txt
+
+instance IsTxt Txt where
+ _IsTxt =
+ id
+
+instance IsTxt String where
+ _IsTxt =
+ from _Wrapped
+
+instance SetTxt () where
+instance FoldTxt () where
+ _FoldTxt =
+ _ManyTxt
+instance ManyTxt () where
+ _ManyTxt _ x =
+ pure x
diff --git a/src/Data/Aviation/Aip/Year.hs b/src/Data/Aviation/Aip/Year.hs
deleted file mode 100644
index 8b39273..0000000
--- a/src/Data/Aviation/Aip/Year.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Data.Aviation.Aip.Year(
- Year(..)
-, parseYear
-, HasYear(..)
-) where
-
-import Data.Digit(Digit, parsedigit)
-import Text.Parser.Char(CharParsing)
-import Papa
-
-data Year =
- Year {
- _year1 ::
- Digit
- , _year2 ::
- Digit
- , _year3 ::
- Digit
- , _year4 ::
- Digit
- }
- deriving (Eq, Ord, Show)
-
-parseYear ::
- (CharParsing p, Monad p) =>
- p Year
-parseYear =
- Year <$> parsedigit <*> parsedigit <*> parsedigit <*> parsedigit
-
-makeClassy ''Year
diff --git a/src/Main.hs b/src/Main.hs
deleted file mode 100644
index 87ffd18..0000000
--- a/src/Main.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Main(
- main
-) where
-
-import Control.Monad.IO.Class(MonadIO(liftIO))
-import Data.Aviation.Aip.AipDocuments(writeAipDocuments)
-import Control.Monad.Trans.Except(runExceptT)
-import System.Directory(createDirectoryIfMissing)
-import System.Environment(getArgs)
-import System.FilePath((</>))
-import System.IO(IO, Handle, IOMode(AppendMode), withFile, hPutStrLn, stderr)
-import Papa
-
-main ::
- IO ()
-main =
- do a <- getArgs
- case a of
- adir:ldir:_ ->
- let wlogfile ::
- MonadIO m =>
- FilePath
- -> (Handle -> IO a)
- -> m a
- wlogfile f =
- liftIO . withFile (ldir </> f) AppendMode
- ex =
- do liftIO (mapM_ (createDirectoryIfMissing True) [adir, ldir])
- wlogfile "err.log" (\herr ->
- wlogfile "out.log" (\hout ->
- do p <- runExceptT (writeAipDocuments herr hout adir)
- mapM_ (\qs -> appendFile (ldir </> "aip") (qs >>= \q -> q ++ "\n")) p))
- in void (runExceptT ex)
- _ ->
- hPutStrLn stderr "<aip-directory> <log-directory>"
diff --git a/test/Tests.hs b/test/Tests.hs
new file mode 100644
index 0000000..89ad4b3
--- /dev/null
+++ b/test/Tests.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = pure ()
diff --git a/test/doctests.hs b/test/doctests.hs
deleted file mode 100644
index 6f6b78c..0000000
--- a/test/doctests.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Main where
-
-import Build_doctests (deps)
-import Control.Applicative
-import Control.Monad
-import Data.List
-import System.Directory
-import System.FilePath
-import Test.DocTest
-
-main ::
- IO ()
-main =
- getSources >>= \sources -> doctest $
- "-isrc"
- : "-idist/build/autogen"
- : "-optP-include"
- : "-optPdist/build/autogen/cabal_macros.h"
- : "-hide-all-packages"
- : map ("-package="++) deps ++ sources
-
-getSources :: IO [FilePath]
-getSources = filter (isSuffixOf ".hs") <$> go "src"
- where
- go dir = do
- (dirs, files) <- getFilesAndDirectories dir
- (files ++) . concat <$> mapM go dirs
-
-getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
-getFilesAndDirectories dir = do
- c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
- (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c