packages feed

route-planning (empty) → 0.0.1

raw patch · 21 files changed

+1356/−0 lines, 21 filesdep +QuickCheckdep +basedep +containersbuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, containers, coordinate, directory, doctest, filepath, lens, semigroupoids, semigroups, text, xsd

Files

+ Setup.lhs view
@@ -0,0 +1,44 @@+#!/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}
+ etc/LICENCE view
@@ -0,0 +1,27 @@+Copyright 2013 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ route-planning.cabal view
@@ -0,0 +1,87 @@+name:               route-planning+version:            0.0.1+license:            BSD3+license-File:       etc/LICENCE+author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer:         Tony Morris+copyright:          Copyright (C) 2013 Tony Morris+synopsis:           A library and utilities for creating a route+category:           Data+description:        A library and utilities for creating a route+homepage:           https://github.com/tonymorris/route+bug-reports:        https://github.com/tonymorris/route/issues+cabal-version:      >= 1.10+build-type:         Custom++source-repository   head+  type:             git+  location:         git@github.com:tonymorris/route.git++flag                small_base+  description:      Choose the new, split-up base package.++library+  default-language:+                    Haskell2010++  build-depends:+                    base < 5 && >= 3+                    , lens >= 3.10+                    , coordinate >= 0.0.8+                    , containers >= 0.5.0.0+                    , semigroups >= 0.8+                    , semigroupoids >= 4.0+                    , xsd >= 0.5.0.1+                    , text >= 1.0++  ghc-options:+                    -Wall++  default-extensions:+                    NoImplicitPrelude++  hs-source-dirs:+                    src++  exposed-modules:+                    Data.Geo.Route+                    Data.Geo.Route.Author+                    Data.Geo.Route.Comment+                    Data.Geo.Route.Copyright+                    Data.Geo.Route.Description+                    Data.Geo.Route.Distance+                    Data.Geo.Route.Elevation+                    Data.Geo.Route.Email+                    Data.Geo.Route.Gpx+                    Data.Geo.Route.Link+                    Data.Geo.Route.Name+                    Data.Geo.Route.Osrm+                    Data.Geo.Route.Plan+                    Data.Geo.Route.Symbol+                    Data.Geo.Route.Track+                    Data.Geo.Route.TrackHeader+                    Data.Geo.Route.Waypoint++test-suite doctests+  type:+                    exitcode-stdio-1.0++  main-is:+                    doctests.hs++  default-language:+                    Haskell2010++  build-depends:+                    base < 5 && >= 3,+                    doctest >= 0.9.7,+                    filepath >= 1.3,+                    directory >= 1.1,+                    QuickCheck >= 2.0++  ghc-options:+                    -Wall+                    -threaded++  hs-source-dirs:+                    test
+ src/Data/Geo/Route.hs view
@@ -0,0 +1,18 @@+module Data.Geo.Route(module R) where++import Data.Geo.Route.Author as R+import Data.Geo.Route.Comment as R+import Data.Geo.Route.Copyright as R+import Data.Geo.Route.Description as R+import Data.Geo.Route.Distance as R+import Data.Geo.Route.Elevation as R+import Data.Geo.Route.Email as R+import Data.Geo.Route.Gpx as R+import Data.Geo.Route.Link as R+import Data.Geo.Route.Name as R+import Data.Geo.Route.Osrm as R+import Data.Geo.Route.Plan as R+import Data.Geo.Route.Symbol as R+import Data.Geo.Route.Track as R+import Data.Geo.Route.TrackHeader as R+import Data.Geo.Route.Waypoint as R
+ src/Data/Geo/Route/Author.hs view
@@ -0,0 +1,79 @@+module Data.Geo.Route.Author(+  Author+, mkAuthor+, mkAuthor'+, authorEmail+, authorLink+) where++import Prelude(Show)+import Control.Applicative((<$>))+import Control.Lens(Lens', lens)+import Data.Bool((&&))+import Data.Eq(Eq)+import Data.Foldable(Foldable(foldMap))+import Data.Function(id)+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.Maybe(Maybe(Nothing, Just), isNothing)+import Data.Ord(Ord)+import Data.String(String)+import Data.Traversable(Traversable(traverse))+import Text.Printf(printf)++data Author =+  Author+    (Maybe Name) -- name+    (Maybe Email) -- email+    (Maybe Link) -- link+  deriving (Eq, Ord, Show)++mkAuthor ::+  Author+mkAuthor =+  Author Nothing Nothing Nothing++mkAuthor' ::+  Name+  -> Email+  -> Link+  -> Author+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++authorEmail ::+  Lens' Author (Maybe Email)+authorEmail =+    lens (\(Author _ e _) -> e) (\(Author n _ l) e -> Author n e l)++authorLink ::+  Lens' Author (Maybe Link)+authorLink =+    lens (\(Author _ _ l) -> l) (\(Author n e _) l -> Author n e l)++instance Gpx Author where+  gpx (Author n e l) =+    let gpx' :: (Foldable t, Gpx a) => t a -> String+        gpx' = foldMap gpx+    in if isNothing n && isNothing e && isNothing l+       then ""+       else printf "%s%s%s%s%s"+              "<author>"+              (gpx' n)+              (gpx' e)+              (gpx' l)+              "</author>"++class HasAuthor t where+  author ::+    Lens' t Author++instance HasAuthor Author where+  author =+    id
+ src/Data/Geo/Route/Comment.hs view
@@ -0,0 +1,60 @@+module Data.Geo.Route.Comment(+  Comment+, HasComment(..)+, HasComments(..)+, commentIso+, (<!>)+) where++import Prelude(Show)+import Data.Eq(Eq)+import Data.Function(id)+import Data.List((++))+import Data.Ord(Ord)+import Data.String(String, IsString(fromString))+import Control.Lens(Lens', Iso', Traversal', iso, set)+import Data.Geo.Route.Gpx(Gpx(gpx))++newtype Comment =+  Comment+    String+  deriving (Eq, Ord, Show)++commentIso ::+  Iso' String Comment+commentIso =+  iso Comment (\(Comment s) -> s)++class HasComment t where+  comment ::+    Lens' t Comment++instance HasComment Comment where+  comment =+    id++class HasComments t where+  comments ::+    Traversal' t Comment++instance HasComments Comment where+  comments =+    id++instance IsString Comment where+  fromString =+    Comment++instance Gpx Comment where+  gpx (Comment c) =+    "<cmt>" ++ c ++ "</cmt>"++(<!>) ::+  HasComments t =>+  Comment+  -> t+  -> t+(<!>) =+  set comments++infixr 5 <!>
+ src/Data/Geo/Route/Copyright.hs view
@@ -0,0 +1,58 @@+module Data.Geo.Route.Copyright(+  Copyright+, copyright+, copyright'+, copyrightAuthor+, copyrightYear+, copyrightLicense+) where++import Prelude(Show)+import Control.Lens(Lens', lens)+import Data.Eq(Eq)+import Data.Foldable(Foldable(fold))+import Data.Geo.Route.Gpx(Gpx(gpx))+import Data.Maybe(Maybe(Just, Nothing))+import Data.Ord(Ord)+import Data.String(String)+import Text.Printf(printf)++data Copyright =+  Copyright+    String -- author+    (Maybe String) -- year+    (Maybe String) -- license+  deriving (Eq, Ord, Show)++copyright ::+  String+  -> Copyright+copyright a =+  Copyright a Nothing Nothing++copyright' ::+  String+  -> String+  -> String+  -> Copyright+copyright' a y l =+  Copyright a (Just y) (Just l)++copyrightAuthor ::+  Lens' Copyright String+copyrightAuthor =+    lens (\(Copyright a _ _) -> a) (\(Copyright _ y l) a -> Copyright a y l)++copyrightYear ::+  Lens' Copyright (Maybe String)+copyrightYear =+    lens (\(Copyright _ y _) -> y) (\(Copyright a _ l) y -> Copyright a y l)++copyrightLicense ::+  Lens' Copyright (Maybe String)+copyrightLicense =+    lens (\(Copyright _ _ l) -> l) (\(Copyright a y _) l -> Copyright a y l)++instance Gpx Copyright where+  gpx (Copyright a y l) =+    printf "<copyright author=\"%s\">%s%s</copyright>" a (fold y) (fold l)
+ src/Data/Geo/Route/Description.hs view
@@ -0,0 +1,60 @@+module Data.Geo.Route.Description(+  Description+, HasDescription(..)+, HasDescriptions(..)+, descriptionIso+, (<~>)+) where++import Prelude(Show)+import Data.Eq(Eq)+import Data.Function(id)+import Data.List((++))+import Data.Ord(Ord)+import Data.String(String, IsString(fromString))+import Control.Lens(Lens', Traversal', Iso', iso, set)+import Data.Geo.Route.Gpx(Gpx(gpx))++newtype Description =+  Description+    String+  deriving (Eq, Ord, Show)++descriptionIso ::+  Iso' String Description+descriptionIso =+  iso Description (\(Description s) -> s)++class HasDescription t where+  description ::+    Lens' t Description++instance HasDescription Description where+  description =+    id++class HasDescriptions t where+  descriptions ::+    Traversal' t Description++instance HasDescriptions Description where+  descriptions =+    id++instance IsString Description where+  fromString =+    Description++instance Gpx Description where+  gpx (Description d) =+    "<desc>" ++ d ++ "</desc>"++(<~>) ::+  HasDescriptions t =>+  Description+  -> t+  -> t+(<~>) =+  set descriptions++infixr 5 <~>
+ src/Data/Geo/Route/Distance.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Geo.Route.Distance(+  Distance+, HasDistance(..)+, HasMaybeDistance(..)+, distanceIso+) where++import Prelude(Show, Num, Real, Enum, Integral)+import Data.Eq(Eq)+import Data.Function(id)+import Data.Int(Int)+import Data.Maybe(Maybe)+import Data.Ord(Ord)+import Control.Lens(Lens', Iso', iso)++newtype Distance =+  Distance+    Int+  deriving (Eq, Ord, Show, Num, Real, Enum, Integral)++distanceIso ::+  Iso' Int Distance+distanceIso =+  iso Distance (\(Distance s) -> s)++class HasDistance t where+  distance ::+    Lens' t Distance++class HasMaybeDistance t where+  maybeDistance ::+    Lens' t (Maybe Distance)++instance HasDistance Distance where+  distance =+    id
+ src/Data/Geo/Route/Elevation.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Geo.Route.Elevation(+  Elevation+, HasElevation(..)+, HasElevations(..)+, elevationIso+, (<^>)+) where++import Prelude(Show(show), Num, Real, Enum, Integral)+import Data.Eq(Eq)+import Data.Function(id)+import Data.Geo.Route.Gpx(Gpx(gpx))+import Data.Int(Int)+import Data.List((++))+import Data.Ord(Ord)+import Control.Lens(Lens', Iso', Traversal', iso, set)++newtype Elevation =+  Elevation+    Int+  deriving (Eq, Ord, Show, Num, Real, Enum, Integral)++elevationIso ::+  Iso' Int Elevation+elevationIso =+  iso Elevation (\(Elevation s) -> s)++class HasElevation t where+  elevation ::+    Lens' t Elevation++instance HasElevation Elevation where+  elevation =+    id++class HasElevations t where+  elevations ::+    Traversal' t Elevation++instance HasElevations Elevation where+  elevations =+    id++instance Gpx Elevation where+  gpx (Elevation e) =+    "<ele>" ++ show e ++ "</ele>"++(<^>) ::+  HasElevations t =>+  Elevation+  -> t+  -> t+(<^>) =+  set elevations++infixr 5 <^>
+ src/Data/Geo/Route/Email.hs view
@@ -0,0 +1,41 @@+module Data.Geo.Route.Email(+  Email+, email+, emailId+, emailDomain+) where++import Prelude(Show)+import Data.Geo.Route.Gpx(Gpx(gpx))+import Control.Lens(Lens', lens)+import Data.String(String)+import Data.Eq(Eq)+import Data.Ord(Ord)+import Text.Printf(printf)++data Email =+  Email+    String -- id+    String -- domain+  deriving (Eq, Ord, Show)++email ::+  String+  -> String+  -> Email+email =+  Email++emailId ::+  Lens' Email String+emailId =+  lens (\(Email i _) -> i) (\(Email _ d) i -> Email i d)++emailDomain ::+  Lens' Email String+emailDomain =+  lens (\(Email _ d) -> d) (\(Email i _) d -> Email i d)++instance Gpx Email where+  gpx (Email i d) =+    printf "<email id=\"%s\" domain=\"%s\"/>" i d
+ src/Data/Geo/Route/Gpx.hs view
@@ -0,0 +1,18 @@+module Data.Geo.Route.Gpx(+  Gpx(..)+) where++import Control.Lens((#))+import Data.List((++))+import Data.String(String)+import Data.Text(unpack)+import Text.XML.XSD.DateTime(DateTime, dateTime)++class Gpx x where+  gpx ::+    x+    -> String++instance Gpx DateTime where+  gpx d =+    "<time>" ++ unpack (dateTime # d) ++ "</time>"
+ src/Data/Geo/Route/Link.hs view
@@ -0,0 +1,49 @@+module Data.Geo.Route.Link(+  Link+, link+, linkHref+, linkText+, linkType+) where++import Prelude(Show)+import Control.Lens(Lens', lens)+import Data.Eq(Eq)+import Data.Geo.Route.Gpx(Gpx(gpx))+import Data.Ord(Ord)+import Data.String(String)+import Text.Printf(printf)++data Link =+  Link+    String -- href+    String -- text+    String -- type+  deriving (Eq, Ord, Show)++link ::+  String+  -> String+  -> String+  -> Link+link =+  Link++instance Gpx Link where+  gpx (Link h x t) =+    printf "<link href=\"%s\"><text>%s</text><type>%s</type></link>" h x t++linkHref ::+  Lens' Link String+linkHref =+    lens (\(Link h _ _) -> h) (\(Link _ x t) h -> Link h x t)++linkText ::+  Lens' Link String+linkText =+    lens (\(Link _ x _) -> x) (\(Link h _ t) x -> Link h x t)++linkType ::+  Lens' Link String+linkType =+    lens (\(Link _ _ t) -> t) (\(Link h x _) t -> Link h x t)
+ src/Data/Geo/Route/Name.hs view
@@ -0,0 +1,60 @@+module Data.Geo.Route.Name(+  Name+, HasName(..)+, HasNames(..)+, nameIso+, (<.>)+) where++import Prelude(Show)+import Data.Eq(Eq)+import Data.Function(id)+import Data.Ord(Ord)+import Data.List((++))+import Data.String(String, IsString(..))+import Control.Lens(Lens', Traversal', Iso', iso, set)+import Data.Geo.Route.Gpx(Gpx(gpx))++newtype Name =+  Name+    String+  deriving (Eq, Ord, Show)++nameIso ::+  Iso' String Name+nameIso =+  iso Name (\(Name s) -> s)++class HasName t where+  name ::+    Lens' t Name++instance HasName Name where+  name =+    id++class HasNames t where+  names ::+    Traversal' t Name++instance HasNames Name where+  names =+    id++instance IsString Name where+  fromString =+    Name++instance Gpx Name where+  gpx (Name n) =+    "<name>" ++ n ++ "</name>"++(<.>) ::+  HasNames t =>+  Name+  -> t+  -> t+(<.>) =+  set names++infixr 5 <.>
+ src/Data/Geo/Route/Osrm.hs view
@@ -0,0 +1,40 @@+module Data.Geo.Route.Osrm(+  Osrm(..)+) where++import Prelude(Show(show))+import Data.Eq(Eq((==)))+import Data.Function(id, (.))+import Data.Functor(Functor(fmap))+import Data.List((++), intercalate)+import Data.String(String)+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))+import Text.Printf(printf)++class Osrm o where+  allCoordinates ::+    o+    -> [Coordinate]+  osrm ::+    o+    -> String+  osrm =+    let removeAdjacentDuplicates ::+          Eq a =>+          [a]+          -> [a]+        removeAdjacentDuplicates [] =+          []+        removeAdjacentDuplicates [h] =+          [h]+        removeAdjacentDuplicates (h:x:xs) =+          (if h == x then id else (h:)) (removeAdjacentDuplicates (x:xs))+    in ("http://map.project-osrm.org/?" ++) .+       intercalate "&" .+       fmap (\c -> let c' = c ^. coordinate+                   in printf "loc=%0.6f,%0.6f" (fracLatitude # (c' ^. latitude)) (fracLongitude # (c' ^. longitude))) .+       removeAdjacentDuplicates .+       allCoordinates
+ src/Data/Geo/Route/Plan.hs view
@@ -0,0 +1,92 @@+module Data.Geo.Route.Plan(+  Plan+, mkPlan+, mkPlan'+) where++import Prelude(Show)+import Control.Applicative((<$>))+import Control.Monad(Monad((>>=)))+import Data.Bool((&&))+import Data.Eq(Eq)+import Data.Foldable(Foldable(foldMap))+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.Gpx(Gpx(gpx))+import Data.Geo.Route.Name(Name, HasNames(names))+import Data.Geo.Route.Osrm(Osrm(allCoordinates))+import Data.Geo.Route.Track(Track, trackPoints)+import Data.Geo.Route.Waypoint(gpxWaypoint)+import Text.Printf(printf)++data Plan =+  Plan+    (Maybe Name) -- name+    (Maybe Description) -- description+    (Maybe Author) -- author+    (Maybe Copyright) -- copyright+    Track+  deriving (Eq, Ord, Show)++mkPlan ::+  Track+  -> Plan+mkPlan =+  Plan Nothing Nothing Nothing Nothing++mkPlan' ::+  Name+  -> Description+  -> Author+  -> Copyright+  -> Track+  -> Plan+mkPlan' n d a c =+  Plan (Just n) (Just d) (Just a) (Just c)++instance Gpx Plan where+  gpx (Plan n d a c t) =+    let gpx' :: (Foldable t, Gpx a) => t a -> String+        gpx' = foldMap gpx+        metadata =+          if isNothing n && isNothing d && isNothing a && isNothing c+          then ""+          else printf "%s%s%s%s%s%s"+                 "<metadata>"+                 (gpx' n)+                 (gpx' d)+                 (gpx' a)+                 (gpx' c)+                 "</metadata>"+        wpt =+          trackPoints t >>= gpx+        rte ::+          String+        rte =+          printf "<rte>%s</rte>" (trackPoints t >>= gpxWaypoint "rtept")+        trk =+          gpx t+    in printf "%s%s%s%s%s%s"+              "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?><gpx xmlns=\"http://www.topografix.com/GPX/1/1\" creator=\"Data.Geo.Route\" version=\"1.1\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:schemaLocation=\"http://www.garmin.com/xmlschemas/GpxExtensions/v3 http://www.garmin.com/xmlschemas/GpxExtensionsv3.xsd http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd\">"+              metadata+              wpt+              rte+              trk+              "</gpx>"++instance Osrm Plan where+  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 HasDescriptions Plan where+  descriptions f (Plan n d a c t) =+    (\d' -> Plan n d' a c t) <$> traverse f d
+ src/Data/Geo/Route/Symbol.hs view
@@ -0,0 +1,60 @@+module Data.Geo.Route.Symbol(+  Symbol+, HasSymbol(..)+, HasSymbols(..)+, symbolIso+, (<@>)+) where++import Prelude(Show)+import Data.Eq(Eq)+import Data.Function(id)+import Data.List((++))+import Data.Ord(Ord)+import Data.String(String, IsString(fromString))+import Control.Lens(Lens', Iso', Traversal', iso, set)+import Data.Geo.Route.Gpx(Gpx(gpx))++newtype Symbol =+  Symbol+    String+  deriving (Eq, Ord, Show)++symbolIso ::+  Iso' String Symbol+symbolIso =+  iso Symbol (\(Symbol s) -> s)++class HasSymbol t where+  symbol ::+    Lens' t Symbol++instance HasSymbol Symbol where+  symbol =+    id++class HasSymbols t where+  symbols ::+    Traversal' t Symbol++instance HasSymbols Symbol where+  symbols =+    id++instance IsString Symbol where+  fromString =+    Symbol++instance Gpx Symbol where+  gpx (Symbol s) =+    "<sym>" ++ s ++ "</sym>"++(<@>) ::+  HasSymbols t =>+  Symbol+  -> t+  -> t+(<@>) =+  set symbols++infixr 5 <@>
+ src/Data/Geo/Route/Track.hs view
@@ -0,0 +1,142 @@+module Data.Geo.Route.Track(+  Track+, HasTrack(..)+, (-|)+, (.|)+, (--|)+, (..|)+, (|-|)+, (|.|)+, (|--|)+, (|..|)+, trackPoints+) where++import Prelude(Show)+import Control.Lens(Lens', (^.), lens)+import Control.Monad(Monad(return, (>>=)))+import Data.Eq(Eq)+import Data.Function(id)+import Data.Functor.Apply(Apply, liftF2)+import Data.Ord(Ord)+import Data.String(String)+import Data.Geo.Coordinate(HasCoordinate(coordinate))+import Data.Geo.Route.Gpx(Gpx(gpx))+import Data.Geo.Route.Osrm(Osrm(allCoordinates))+import Data.Geo.Route.TrackHeader(TrackHeader, HasTrackHeader(trackHeader), emptyTrackHeader)+import Data.Geo.Route.Waypoint(Waypoint, gpxWaypoint)+import Data.List(concat)+import Text.Printf(printf)++data Track =+  Track TrackHeader [[Waypoint]]+  deriving (Eq, Ord, Show)++(-|) ::+  Waypoint+  -> Waypoint+  -> Track+w1 -| w2 =+  Track emptyTrackHeader [[w1, w2]]++infixr 5 -|++(.|) ::+  Apply f =>+  f Waypoint+  -> f Waypoint+  -> f Track+(.|)=+  liftF2 (-|)++infixr 5 .|++(--|) ::+  Waypoint+  -> Waypoint+  -> Track+w1 --| w2 =+  Track emptyTrackHeader [[w1], [w2]]++infixr 5 --|++(..|) ::+  Apply f =>+  f Waypoint+  -> f Waypoint+  -> f Track+(..|)=+  liftF2 (--|)++infixr 5 ..|++(|-|) ::+  Waypoint+  -> Track+  -> Track+w |-| Track r [] =+  Track r [[w]]+w |-| Track r (h:t) =+  Track r ((w:h):t)++infixr 5 |-|++(|.|) ::+  Apply f =>+  f Waypoint+  -> f Track+  -> f Track+(|.|) =+  liftF2 (|-|)++infixr 5 |.|++(|--|) ::+  Waypoint+  -> Track+  -> Track+w |--| Track r t =+  Track r ([w]:t)++infixr 5 |--|++(|..|) ::+  Apply f =>+  f Waypoint+  -> f Track+  -> f Track+(|..|) =+  liftF2 (|--|)++infixr 5 |..|++trackPoints ::+  Track+  -> [Waypoint]+trackPoints (Track _ t) =+  concat t+++class HasTrack t where+  track ::+    Lens' t Track++instance HasTrack Track where+  track =+    id++instance HasTrackHeader Track where+  trackHeader =+    lens (\(Track r _) -> r) (\(Track _ t) r -> Track r t)+++instance Osrm Track where+  allCoordinates (Track _ t) =+    do w <- t+       x <- w+       return (x ^. coordinate)++instance Gpx Track where+  gpx (Track r t) =+    printf "<trk>%s%s</trk>" (gpx r) (t >>= \listways ->+                                    printf "<trkseg>%s</trkseg>" (listways >>= gpxWaypoint "trkpt") :: String)
+ src/Data/Geo/Route/TrackHeader.hs view
@@ -0,0 +1,106 @@+module Data.Geo.Route.TrackHeader(+  TrackHeader+, mkTrackHeader+, mkTrackHeader'+, emptyTrackHeader+, HasTrackHeader(..)+, (<..>)+, (<..^)+) where++import Prelude(Show)+import Control.Applicative((<$>))+import Control.Lens(Lens', (^.), set)+import Data.Eq(Eq)+import Data.Foldable(Foldable(foldMap))+import Data.Function(id)+import Data.Functor(Functor(fmap))+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.Gpx(Gpx(gpx))+import Data.Geo.Route.Name(Name, HasNames(names), nameIso)+import Text.Printf(printf)++data TrackHeader =+  TrackHeader+    (Maybe Name)+    (Maybe Comment)+    (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 HasComments TrackHeader where+  comments f (TrackHeader n c d) =+    (\c' -> TrackHeader n c' d) <$> traverse f c++instance HasDescriptions TrackHeader where+  descriptions f (TrackHeader n c d) =+    TrackHeader n c <$> traverse f d++mkTrackHeader ::+  Maybe Name+  -> Maybe Comment+  -> Maybe Description+  -> TrackHeader+mkTrackHeader =+  TrackHeader++mkTrackHeader' ::+  Name+  -> Comment+  -> Description+  -> TrackHeader+mkTrackHeader' m c d =+  TrackHeader+    (Just m)+    (Just c)+    (Just d)++emptyTrackHeader ::+  TrackHeader+emptyTrackHeader =+  mkTrackHeader+    Nothing+    Nothing+    Nothing++class HasTrackHeader t where+  trackHeader ::+    Lens' t TrackHeader++instance HasTrackHeader TrackHeader where+  trackHeader =+    id++(<..>) ::+  HasTrackHeader t =>+  String+  -> t+  -> t+s <..> t =+  set trackHeader (mkTrackHeader' (s ^. nameIso) (s ^. commentIso) (s ^. descriptionIso)) t++infixr 5 <..>++(<..^) ::+  (Functor f, HasTrackHeader t) =>+  String+  -> f t+  -> f t+s <..^ t =+  fmap (s <..>) t++infixr 5 <..^++instance Gpx TrackHeader where+  gpx (TrackHeader n c d) =+    let gpx' :: (Foldable t, Gpx a) => t a -> String+        gpx' = foldMap gpx+    in printf "%s%s%s" (gpx' n) (gpx' c) (gpx' d)
+ src/Data/Geo/Route/Waypoint.hs view
@@ -0,0 +1,187 @@+module Data.Geo.Route.Waypoint(+  Waypoint+, Waypoints+, HasWaypoint(..)+, HasWaypoints(..)+, HasDateTimes(..)+, mkWaypoint+, gpxWaypoint+, (.<.>)+, (~<.>)+, (<%>)+, (<.?>)+, (-.-)+) where+++import Prelude(Show(show), Double)+import Control.Applicative((<$>))+import Data.Eq(Eq)+import Data.Foldable(Foldable(foldMap))+import Data.Function(id, (.))+import Data.Functor(Functor(fmap))+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 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.Gpx(Gpx(gpx))+import Data.Geo.Route.Name(Name, HasNames(names), nameIso)+import Data.Geo.Route.Symbol(Symbol, HasSymbols(symbols))+import Text.Printf(printf)+import Text.XML.XSD.DateTime(DateTime)++data Waypoint =+  Waypoint+    Coordinate+    (Maybe Elevation)+    (Maybe DateTime)+    (Maybe Name)+    (Maybe Comment)+    (Maybe Description)+    (Maybe Symbol)+  deriving (Eq, Ord, Show)++type Waypoints =+  [Waypoint]++mkWaypoint ::+  HasCoordinate c =>+  c+  -> Waypoint+mkWaypoint c =+  Waypoint (c ^. coordinate) Nothing Nothing Nothing Nothing Nothing Nothing++instance HasCoordinate Waypoint where+  coordinate =+    lens (\(Waypoint c _ _ _ _ _ _) -> c) (\(Waypoint _ e d n m s y) c -> Waypoint c e d n m s y)++instance HasLatitude Waypoint where+  latitude =+    coordinate . latitude++instance HasLongitude Waypoint where+  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 HasDateTimes DateTime where+  dateTimes =+    id++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++(<%>) ::+  HasDateTimes t =>+  DateTime+  -> t+  -> t+(<%>) =+  set dateTimes++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 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 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 HasSymbols Waypoint where+  symbols f (Waypoint c e d n m s y) =+    Waypoint c e d n m s <$> traverse f y++class HasWaypoint t where+  waypoint ::+    Lens' t Waypoint++instance HasWaypoint Waypoint where+  waypoint =+    id++class HasWaypoints t where+  waypoints ::+    Lens' t Waypoints++gpxWaypoint ::+  (HasNames s, HasComments s, HasSymbols s, HasElevations s, HasDescriptions s, HasLatitude s, HasLongitude s,HasDateTimes 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+      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++instance Gpx Waypoint where+  gpx =+    gpxWaypoint "wpt"++(.<.>) ::+  String+  -> Coordinate+  -> Waypoint+s .<.> c =+  let ups i = Just (s ^. i)+  in Waypoint c Nothing Nothing (ups nameIso) (ups commentIso) (ups descriptionIso) Nothing++infixr 5 .<.>++(~<.>) ::+  Name+  -> Coordinate+  -> Waypoint+n ~<.> c =+  Waypoint c Nothing Nothing (Just n) Nothing Nothing Nothing++infixr 5 ~<.>++(<.?>) ::+  Double+  -> Double+  -> Maybe Waypoint+x <.?> y =+  fmap mkWaypoint (x ..#.. y)++infixr 6 <.?>++(-.-) ::+  HasWaypoints t =>+  Maybe Waypoint+  -> t+  -> t+(-.-) Nothing =+  id+(-.-) (Just w) =+  over waypoints (w:)++infixr 6 -.-
+ test/doctests.hs view
@@ -0,0 +1,32 @@+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