packages feed

route-planning 0.0.1 → 0.0.2

raw patch · 13 files changed

+110/−135 lines, 13 files

Files

route-planning.cabal view
@@ -1,5 +1,5 @@ name:               route-planning-version:            0.0.1+version:            0.0.2 license:            BSD3 license-File:       etc/LICENCE author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>
src/Data/Geo/Route/Author.hs view
@@ -7,7 +7,6 @@ ) where  import Prelude(Show)-import Control.Applicative((<$>)) import Control.Lens(Lens', lens) import Data.Bool((&&)) import Data.Eq(Eq)@@ -16,11 +15,10 @@ import Data.Geo.Route.Email(Email) import Data.Geo.Route.Gpx(Gpx(gpx)) import Data.Geo.Route.Link(Link)-import Data.Geo.Route.Name(HasNames(names), Name)+import Data.Geo.Route.Name(HasMaybeName(mname), Name) import Data.Maybe(Maybe(Nothing, Just), isNothing) import Data.Ord(Ord) import Data.String(String)-import Data.Traversable(Traversable(traverse)) import Text.Printf(printf)  data Author =@@ -43,9 +41,9 @@ mkAuthor' e l a =   Author (Just e) (Just l) (Just a) -instance HasNames Author where-  names f (Author n l a) =-    (\n' -> Author n' l a) <$> traverse f n+instance HasMaybeName Author where+  mname =+    lens (\(Author n _ _) -> n) (\(Author _ e l) n -> Author n e l)  authorEmail ::   Lens' Author (Maybe Email)
src/Data/Geo/Route/Comment.hs view
@@ -1,7 +1,7 @@ module Data.Geo.Route.Comment(   Comment , HasComment(..)-, HasComments(..)+, HasMaybeComment(..) , commentIso , (<!>) ) where@@ -10,9 +10,10 @@ import Data.Eq(Eq) import Data.Function(id) import Data.List((++))+import Data.Maybe(Maybe) import Data.Ord(Ord) import Data.String(String, IsString(fromString))-import Control.Lens(Lens', Iso', Traversal', iso, set)+import Control.Lens(Lens', Iso', iso, (?~)) import Data.Geo.Route.Gpx(Gpx(gpx))  newtype Comment =@@ -33,13 +34,9 @@   comment =     id -class HasComments t where-  comments ::-    Traversal' t Comment--instance HasComments Comment where-  comments =-    id+class HasMaybeComment t where+  mcomment ::+    Lens' t (Maybe Comment)  instance IsString Comment where   fromString =@@ -50,11 +47,11 @@     "<cmt>" ++ c ++ "</cmt>"  (<!>) ::-  HasComments t =>+  HasMaybeComment t =>   Comment   -> t   -> t (<!>) =-  set comments+  (?~) mcomment  infixr 5 <!>
src/Data/Geo/Route/Copyright.hs view
@@ -10,8 +10,9 @@ import Prelude(Show) import Control.Lens(Lens', lens) import Data.Eq(Eq)-import Data.Foldable(Foldable(fold))+import Data.Foldable(Foldable(foldMap)) import Data.Geo.Route.Gpx(Gpx(gpx))+import Data.List((++)) import Data.Maybe(Maybe(Just, Nothing)) import Data.Ord(Ord) import Data.String(String)@@ -55,4 +56,4 @@  instance Gpx Copyright where   gpx (Copyright a y l) =-    printf "<copyright author=\"%s\">%s%s</copyright>" a (fold y) (fold l)+    printf "<copyright author=\"%s\">%s%s</copyright>" a (foldMap (\y' -> "<year>" ++ y' ++ "</year>") y) (foldMap (\l' -> "<license>" ++ l' ++ "</license>") l)
src/Data/Geo/Route/Description.hs view
@@ -1,7 +1,7 @@ module Data.Geo.Route.Description(   Description , HasDescription(..)-, HasDescriptions(..)+, HasMaybeDescription(..) , descriptionIso , (<~>) ) where@@ -10,9 +10,10 @@ import Data.Eq(Eq) import Data.Function(id) import Data.List((++))+import Data.Maybe(Maybe) import Data.Ord(Ord) import Data.String(String, IsString(fromString))-import Control.Lens(Lens', Traversal', Iso', iso, set)+import Control.Lens(Lens', Iso', iso, (?~)) import Data.Geo.Route.Gpx(Gpx(gpx))  newtype Description =@@ -33,13 +34,9 @@   description =     id -class HasDescriptions t where-  descriptions ::-    Traversal' t Description--instance HasDescriptions Description where-  descriptions =-    id+class HasMaybeDescription t where+  mdescription ::+    Lens' t (Maybe Description)  instance IsString Description where   fromString =@@ -50,11 +47,11 @@     "<desc>" ++ d ++ "</desc>"  (<~>) ::-  HasDescriptions t =>+  HasMaybeDescription t =>   Description   -> t   -> t (<~>) =-  set descriptions+  (?~) mdescription  infixr 5 <~>
src/Data/Geo/Route/Elevation.hs view
@@ -3,7 +3,7 @@ module Data.Geo.Route.Elevation(   Elevation , HasElevation(..)-, HasElevations(..)+, HasMaybeElevation(..) , elevationIso , (<^>) ) where@@ -14,8 +14,9 @@ import Data.Geo.Route.Gpx(Gpx(gpx)) import Data.Int(Int) import Data.List((++))+import Data.Maybe(Maybe) import Data.Ord(Ord)-import Control.Lens(Lens', Iso', Traversal', iso, set)+import Control.Lens(Lens', Iso', iso, (?~))  newtype Elevation =   Elevation@@ -35,24 +36,20 @@   elevation =     id -class HasElevations t where-  elevations ::-    Traversal' t Elevation--instance HasElevations Elevation where-  elevations =-    id+class HasMaybeElevation t where+  melevation ::+    Lens' t (Maybe Elevation)  instance Gpx Elevation where   gpx (Elevation e) =     "<ele>" ++ show e ++ "</ele>"  (<^>) ::-  HasElevations t =>+  HasMaybeElevation t =>   Elevation   -> t   -> t (<^>) =-  set elevations+  (?~) melevation  infixr 5 <^>
src/Data/Geo/Route/Gpx.hs view
@@ -2,7 +2,7 @@   Gpx(..) ) where -import Control.Lens((#))+import Control.Lens(( # )) import Data.List((++)) import Data.String(String) import Data.Text(unpack)
src/Data/Geo/Route/Name.hs view
@@ -1,7 +1,7 @@ module Data.Geo.Route.Name(   Name , HasName(..)-, HasNames(..)+, HasMaybeName(..) , nameIso , (<.>) ) where@@ -11,8 +11,9 @@ import Data.Function(id) import Data.Ord(Ord) import Data.List((++))+import Data.Maybe(Maybe) import Data.String(String, IsString(..))-import Control.Lens(Lens', Traversal', Iso', iso, set)+import Control.Lens(Lens', Iso', iso, (?~)) import Data.Geo.Route.Gpx(Gpx(gpx))  newtype Name =@@ -33,13 +34,9 @@   name =     id -class HasNames t where-  names ::-    Traversal' t Name--instance HasNames Name where-  names =-    id+class HasMaybeName t where+  mname ::+    Lens' t (Maybe Name)  instance IsString Name where   fromString =@@ -50,11 +47,11 @@     "<name>" ++ n ++ "</name>"  (<.>) ::-  HasNames t =>+  HasMaybeName t =>   Name   -> t   -> t (<.>) =-  set names+  (?~) mname  infixr 5 <.>
src/Data/Geo/Route/Osrm.hs view
@@ -8,7 +8,7 @@ import Data.Functor(Functor(fmap)) import Data.List((++), intercalate) import Data.String(String)-import Control.Lens((#), (^.))+import Control.Lens(( # ), (^.)) import Data.Geo.Coordinate.Latitude(HasLatitude(latitude), latitude, fracLatitude) import Data.Geo.Coordinate.Longitude(HasLongitude(longitude), longitude, fracLongitude) import Data.Geo.Coordinate.Coordinate(Coordinate, HasCoordinate(coordinate))
src/Data/Geo/Route/Plan.hs view
@@ -5,7 +5,7 @@ ) where  import Prelude(Show)-import Control.Applicative((<$>))+import Control.Lens(lens) import Control.Monad(Monad((>>=))) import Data.Bool((&&)) import Data.Eq(Eq)@@ -13,12 +13,11 @@ import Data.Ord(Ord) import Data.Maybe(Maybe(Nothing, Just), isNothing) import Data.String(String)-import Data.Traversable(Traversable(traverse)) import Data.Geo.Route.Author(Author) import Data.Geo.Route.Copyright(Copyright)-import Data.Geo.Route.Description(Description, HasDescriptions(descriptions))+import Data.Geo.Route.Description(Description, HasMaybeDescription(mdescription)) import Data.Geo.Route.Gpx(Gpx(gpx))-import Data.Geo.Route.Name(Name, HasNames(names))+import Data.Geo.Route.Name(Name, HasMaybeName(mname)) import Data.Geo.Route.Osrm(Osrm(allCoordinates)) import Data.Geo.Route.Track(Track, trackPoints) import Data.Geo.Route.Waypoint(gpxWaypoint)@@ -83,10 +82,10 @@   allCoordinates (Plan _ _ _ _ t) =     allCoordinates t -instance HasNames Plan where-  names f (Plan n d a c t) =-    (\n' -> Plan n' d a c t) <$> traverse f n+instance HasMaybeName Plan where+  mname =+    lens (\(Plan n _ _ _ _) -> n) (\(Plan _ d a c t) n -> Plan n d a c t) -instance HasDescriptions Plan where-  descriptions f (Plan n d a c t) =-    (\d' -> Plan n d' a c t) <$> traverse f d+instance HasMaybeDescription Plan where+  mdescription =+    lens (\(Plan _ d _ _ _) -> d) (\(Plan n _ a c t) d -> Plan n d a c t)
src/Data/Geo/Route/Symbol.hs view
@@ -1,7 +1,7 @@ module Data.Geo.Route.Symbol(   Symbol , HasSymbol(..)-, HasSymbols(..)+, HasMaybeSymbol(..) , symbolIso , (<@>) ) where@@ -10,9 +10,10 @@ import Data.Eq(Eq) import Data.Function(id) import Data.List((++))+import Data.Maybe(Maybe) import Data.Ord(Ord) import Data.String(String, IsString(fromString))-import Control.Lens(Lens', Iso', Traversal', iso, set)+import Control.Lens(Lens', Iso', iso, (?~)) import Data.Geo.Route.Gpx(Gpx(gpx))  newtype Symbol =@@ -33,13 +34,9 @@   symbol =     id -class HasSymbols t where-  symbols ::-    Traversal' t Symbol--instance HasSymbols Symbol where-  symbols =-    id+class HasMaybeSymbol t where+  msymbol ::+    Lens' t (Maybe Symbol)  instance IsString Symbol where   fromString =@@ -50,11 +47,11 @@     "<sym>" ++ s ++ "</sym>"  (<@>) ::-  HasSymbols t =>+  HasMaybeSymbol t =>   Symbol   -> t   -> t (<@>) =-  set symbols+  (?~) msymbol  infixr 5 <@>
src/Data/Geo/Route/TrackHeader.hs view
@@ -9,8 +9,7 @@ ) where  import Prelude(Show)-import Control.Applicative((<$>))-import Control.Lens(Lens', (^.), set)+import Control.Lens(Lens', lens, (^.), set) import Data.Eq(Eq) import Data.Foldable(Foldable(foldMap)) import Data.Function(id)@@ -18,11 +17,10 @@ import Data.Maybe(Maybe(Just, Nothing)) import Data.Ord(Ord) import Data.String(String)-import Data.Traversable(Traversable(traverse))-import Data.Geo.Route.Comment(Comment, HasComments(comments), commentIso)-import Data.Geo.Route.Description(Description, HasDescriptions(descriptions), descriptionIso)+import Data.Geo.Route.Comment(Comment, HasMaybeComment(mcomment), commentIso)+import Data.Geo.Route.Description(Description, HasMaybeDescription(mdescription), descriptionIso) import Data.Geo.Route.Gpx(Gpx(gpx))-import Data.Geo.Route.Name(Name, HasNames(names), nameIso)+import Data.Geo.Route.Name(Name, HasMaybeName(mname), nameIso) import Text.Printf(printf)  data TrackHeader =@@ -32,17 +30,17 @@     (Maybe Description)   deriving (Eq, Ord, Show) -instance HasNames TrackHeader where-  names f (TrackHeader n c d) =-    (\n' -> TrackHeader n' c d) <$> traverse f n+instance HasMaybeName TrackHeader where+  mname =+    lens (\(TrackHeader n _ _) -> n) (\(TrackHeader _ c d) n -> TrackHeader n c d) -instance HasComments TrackHeader where-  comments f (TrackHeader n c d) =-    (\c' -> TrackHeader n c' d) <$> traverse f c+instance HasMaybeComment TrackHeader where+  mcomment =+    lens (\(TrackHeader _ c _) -> c) (\(TrackHeader n _ d) c -> TrackHeader n c d) -instance HasDescriptions TrackHeader where-  descriptions f (TrackHeader n c d) =-    TrackHeader n c <$> traverse f d+instance HasMaybeDescription TrackHeader where+  mdescription =+    lens (\(TrackHeader _ _ d) -> d) (\(TrackHeader n c _) d -> TrackHeader n c d)  mkTrackHeader ::   Maybe Name
src/Data/Geo/Route/Waypoint.hs view
@@ -1,9 +1,9 @@ module Data.Geo.Route.Waypoint(-  Waypoint+  Waypoint(..) , Waypoints , HasWaypoint(..) , HasWaypoints(..)-, HasDateTimes(..)+, HasMaybeDateTime(..) , mkWaypoint , gpxWaypoint , (.<.>)@@ -15,7 +15,6 @@   import Prelude(Show(show), Double)-import Control.Applicative((<$>)) import Data.Eq(Eq) import Data.Foldable(Foldable(foldMap)) import Data.Function(id, (.))@@ -23,17 +22,16 @@ import Data.Maybe(Maybe(Nothing, Just)) import Data.Ord(Ord) import Data.String(String)-import Data.Traversable(traverse)-import Control.Lens(Lens', Traversal', lens, (#), (^.), over, firstOf, set)+import Control.Lens(Lens', lens, ( # ), (^.), over, (?~)) import Data.Geo.Coordinate.Latitude(HasLatitude(latitude), fracLatitude) import Data.Geo.Coordinate.Longitude(HasLongitude(longitude), fracLongitude) import Data.Geo.Coordinate.Coordinate(Coordinate, HasCoordinate(coordinate), (..#..))-import Data.Geo.Route.Comment(Comment, HasComments(comments), commentIso)-import Data.Geo.Route.Description(Description, HasDescriptions(descriptions), descriptionIso)-import Data.Geo.Route.Elevation(Elevation, HasElevations(elevations))+import Data.Geo.Route.Comment(Comment, HasMaybeComment(mcomment), commentIso)+import Data.Geo.Route.Description(Description, HasMaybeDescription(mdescription), descriptionIso)+import Data.Geo.Route.Elevation(Elevation, HasMaybeElevation(melevation)) import Data.Geo.Route.Gpx(Gpx(gpx))-import Data.Geo.Route.Name(Name, HasNames(names), nameIso)-import Data.Geo.Route.Symbol(Symbol, HasSymbols(symbols))+import Data.Geo.Route.Name(Name, HasMaybeName(mname), nameIso)+import Data.Geo.Route.Symbol(Symbol, HasMaybeSymbol(msymbol)) import Text.Printf(printf) import Text.XML.XSD.DateTime(DateTime) @@ -70,47 +68,43 @@   longitude =     coordinate . longitude -instance HasElevations Waypoint where-  elevations f (Waypoint c e d n m s y) =-    (\e' -> Waypoint c e' d n m s y) <$> traverse f e--class HasDateTimes t where-  dateTimes ::-    Traversal' t DateTime+instance HasMaybeElevation Waypoint where+  melevation =+    lens (\(Waypoint _ e _ _ _ _ _) -> e) (\(Waypoint c _ d n m s y) e -> Waypoint c e d n m s y) -instance HasDateTimes DateTime where-  dateTimes =-    id+class HasMaybeDateTime t where+  mdateTime ::+    Lens' t (Maybe DateTime) -instance HasDateTimes Waypoint where-  dateTimes f (Waypoint c e d n m s y) =-    (\d' -> Waypoint c e d' n m s y) <$> traverse f d+instance HasMaybeDateTime Waypoint where+  mdateTime =+    lens (\(Waypoint _ _ d _ _ _ _) -> d) (\(Waypoint c e _ n m s y) d -> Waypoint c e d n m s y)  (<%>) ::-  HasDateTimes t =>+  HasMaybeDateTime t =>   DateTime   -> t   -> t (<%>) =-  set dateTimes+  (?~) mdateTime  infixr 5 <%> -instance HasNames Waypoint where-  names f (Waypoint c e d n m s y) =-    (\n' -> Waypoint c e d n' m s y) <$> traverse f n+instance HasMaybeName Waypoint where+  mname =+    lens (\(Waypoint _ _ _ n _ _ _) -> n) (\(Waypoint c e d _ m s y) n -> Waypoint c e d n m s y) -instance HasComments Waypoint where-  comments f (Waypoint c e d n m s y) =-    (\m' -> Waypoint c e d n m' s y) <$> traverse f m+instance HasMaybeComment Waypoint where+  mcomment =+    lens (\(Waypoint _ _ _ _ m _ _) -> m) (\(Waypoint c e d n _ s y) m -> Waypoint c e d n m s y) -instance HasDescriptions Waypoint where-  descriptions f (Waypoint c e d n m s y) =-    (\s' -> Waypoint c e d n m s' y) <$> traverse f s+instance HasMaybeDescription Waypoint where+  mdescription =+    lens (\(Waypoint _ _ _ _ _ s _) -> s) (\(Waypoint c e d n m _ y) s -> Waypoint c e d n m s y) -instance HasSymbols Waypoint where-  symbols f (Waypoint c e d n m s y) =-    Waypoint c e d n m s <$> traverse f y+instance HasMaybeSymbol Waypoint where+  msymbol =+    lens (\(Waypoint _ _ _ _ _ _ y) -> y) (\(Waypoint c e d n m s _) y -> Waypoint c e d n m s y)  class HasWaypoint t where   waypoint ::@@ -125,19 +119,19 @@     Lens' t Waypoints  gpxWaypoint ::-  (HasNames s, HasComments s, HasSymbols s, HasElevations s, HasDescriptions s, HasLatitude s, HasLongitude s,HasDateTimes s) =>+  (HasMaybeName s, HasMaybeComment s, HasMaybeSymbol s, HasMaybeElevation s, HasMaybeDescription s, HasLatitude s, HasLongitude s, HasMaybeDateTime s) =>   String   -> s   -> String gpxWaypoint element w =   let lat = fracLatitude # (w ^. latitude)       lon = fracLongitude # (w ^. longitude)-      e = firstOf elevations w-      d = firstOf dateTimes w-      n = firstOf names w-      m = firstOf comments w-      s = firstOf descriptions w-      y = firstOf symbols w+      e = w ^. melevation+      d = w ^. mdateTime+      n = w ^. mname+      m = w ^. mcomment+      s = w ^. mdescription+      y = w ^. msymbol       gpx' :: (Foldable t, Gpx a) => t a -> String       gpx' = foldMap gpx   in printf "<%s lat=\"%0.6f\" lon=\"%0.6f\">%s%s%s%s%s%s</%s>" element lat lon (gpx' e) (gpx' d) (gpx' n) (gpx' m) (gpx' s) (gpx' y) element