diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.0.3 + +* refactor of code to allow more options +* allow maxchars option + 0.0.2 * allow .../* request for all on one line diff --git a/metar-http.cabal b/metar-http.cabal --- a/metar-http.cabal +++ b/metar-http.cabal @@ -1,5 +1,5 @@ name: metar-http -version: 0.0.2 +version: 0.0.3 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@sıɹɹoɯʇ> diff --git a/src/Data/Aviation/Metar/Http.hs b/src/Data/Aviation/Metar/Http.hs --- a/src/Data/Aviation/Metar/Http.hs +++ b/src/Data/Aviation/Metar/Http.hs @@ -7,14 +7,16 @@ ) where import Control.Category((.), id) -import Control.Lens((^.), (^?), _Wrapped) +import Control.Lens((^.), (^?), _Wrapped, folded) import Data.Aviation.Metar(getAllMETAR, getAllTAF) import Data.Aviation.Metar.TAFResult(_TAFResultValue) -import Data.ByteString.Lazy.UTF8 hiding (take) +import Data.ByteString.Lazy.UTF8 hiding (take, splitAt) +import Data.Eq(Eq) import Data.Functor((<$>)) import Data.Function(($)) -import Data.List(intercalate, take) -import Data.Maybe(Maybe(Nothing, Just), listToMaybe) +import Data.Int(Int) +import Data.List(intercalate, take, splitAt) +import Data.Maybe(Maybe(Nothing, Just)) import Data.String(String) import Data.Semigroup((<>)) import Data.Text(unpack, toLower) @@ -26,20 +28,160 @@ import System.Environment(getArgs) import System.IO(IO) import Text.Read(Read, reads) -import Text.Show(show) +import Text.Show(Show) readMaybe :: Read a => String -> Maybe a readMaybe n = - fst <$> listToMaybe (reads n) + fst <$> reads n ^? folded +data CharLimit = + NoCharLimit + | MaxChars Int + | MaxCharsAppend Int String + deriving (Eq, Show) + +charLimit :: + CharLimit + -> String + -> String +charLimit m s = + case m of + NoCharLimit -> + s + MaxChars n -> + take n s + MaxCharsAppend n l -> + let (a, b) = + splitAt n s + b' = + case b of + [] -> + [] + _:_ -> + l + in a <> b' + +data Format = + Raw + | MaxLines Int CharLimit + | AllOneLine CharLimit + deriving (Eq, Show) + +-- | +-- +-- >>> format (MaxLines 3 NoCharLimit) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK\nRF00.0/000.4" +-- +-- >>> format (MaxLines 1 NoCharLimit) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK" +-- +-- >>> format (MaxLines 1 (MaxChars 15)) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 0712" +-- +-- >>> format (MaxLines 1 (MaxCharsAppend 15 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 0712abc" +-- +-- >>> format (AllOneLine (MaxCharsAppend 15 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 0712abc" +-- +-- >>> format (AllOneLine (MaxCharsAppend 150 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4" +-- +-- >>> format (AllOneLine (MaxCharsAppend 120 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4" +-- +-- >>> format (AllOneLine (MaxCharsAppend 80 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4" +-- +-- >>> format (AllOneLine (MaxCharsAppend 60 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] +-- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK abc" +format :: + Format + -> [String] + -> String +format f s = + let limitCalate l x = + charLimit l . intercalate x + in case f of + Raw -> + intercalate "\n" s + MaxLines n l -> + limitCalate l "\n" . take n $ s + AllOneLine l -> + limitCalate l " " s + +-- Raw +-- * AllOneLine NoCharLimit +-- */n AllOneLine (MaxChars n) +-- */n/xyz AllOneLine (MaxCharsAppend n xyz) +-- n MaxLines n NoCharLimit +-- n/m MaxLines n (MaxChars m) +-- n/m/xyz MaxLines n (MaxCharsAppend m xyz) +uriPathFormat :: + [String] + -> Format +uriPathFormat [] = + Raw +uriPathFormat (q:r) = + let rawMaybe :: + Read a => + (a -> CharLimit) + -> String + -> CharLimit + rawMaybe f n = + case readMaybe n of + Nothing -> + NoCharLimit + Just c -> + f c + r' = + case r of + [] -> + NoCharLimit + s:ss -> + rawMaybe (\n -> case ss of + [] -> + MaxChars n + t:_ -> + MaxCharsAppend n t) s + in case q of + "*" -> + AllOneLine r' + _ -> + case readMaybe q of + Nothing -> + Raw + Just l -> + MaxLines l r' + metarHTTPapp :: Application metarHTTPapp req withResp = let msg = - "path /metar/ OR /metar// OR /taf/ OR /taf// OR /metar//* OR /taf//*" + let a b = + a <> "\n" <> b + a b = + a "\n" <> b + in "/metar/" + "raw metar for station " + "/metar//*" + "metar for station all on one line" + "/metar//*/" + "metar for station all on one line truncated at " + "/metar//*//" + "metar for station all on one line truncated at and if truncation occurs, append " + "/taf/" + "raw taf for station " + "/taf//*" + "taf for station all on one line" + "/taf//*/" + "taf for station all on one line truncated at " + "/taf//*//" + "taf for station all on one line truncated at and if truncation occurs, append " + "" _404 = responseLBS status404 @@ -49,16 +191,11 @@ (rpt:xxxx:r) -> let xxxx' = unpack xxxx - tk r' = - case unpack <$> r' of - "":_ -> - Just id - "*":_ -> - Just (\k -> [intercalate " " k]) - n:_ -> - take <$> readMaybe n - [] -> - Just id + modifyOutput :: + [String] + -> String + modifyOutput = + format (uriPathFormat (unpack <$> r)) mt = case toLower rpt of "metar" -> @@ -71,27 +208,19 @@ Nothing -> withResp _404 Just (mtt, mtf) -> - case tk r of - Nothing -> + do t <- mtf ^. _Wrapped withResp $ - responseLBS - status404 - [] - ("not a valid number " <> fromString (show r)) - Just q -> - do t <- (intercalate "\n" . q <$> mtf) ^. _Wrapped - withResp $ - case t ^? _TAFResultValue of - Nothing -> - responseLBS - status404 - [] - ("no " <> mtt <> " found for " <> fromString xxxx') - Just x -> - responseLBS - status200 - [(hContentType, "text/plain")] - (fromString x) + case t ^? _TAFResultValue of + Nothing -> + responseLBS + status404 + [] + ("no " <> mtt <> " found for " <> fromString xxxx') + Just x -> + responseLBS + status200 + [(hContentType, "text/plain")] + (fromString (modifyOutput x)) [] -> withResp $ responseLBS