Move build scripts into subdir

build.sh

@@ -1,3 +1,3 @@
 #!/bin/sh
 mkdir -p _shake
-ghc --make Build.hs -rtsopts -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"
+ghc --make build/Build.hs -ibuild -icommon -rtsopts -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"

Build.hs → build/Build.hs

@@ -14,7 +14,8 @@ import qualified Data.ByteString.Lazy.Char8 as BLS8
 import Data.Aeson (ToJSON, encode)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 
-import Tour
+import Types
+import TourJson
 import Track
 import Data.Yaml (encodeFile, decodeFileEither)
 

Track.hs → build/Track.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE Arrows, DeriveGeneric, OverloadedStrings #-}
+{-# LANGUAGE Arrows, OverloadedStrings #-}
 
 module Track (loadTrackPoints, loadCalcElev, renameTracks) where
 
@@ -9,16 +9,15 @@ import Data.Time.Format (parseTimeM, defaultTimeLocale)
 import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
 import qualified Data.ByteString.Lazy as BLS
 import Control.Monad (void)
-import GHC.Generics
-
-import Data.Aeson
 
 import Text.XML.HXT.Core
 import Text.XML.HXT.XPath.Arrows
 
 import Naqsha.Geometry
 import Naqsha.Geometry.Spherical (distance)
 
+import Types
+
 data TrackPoint = TrackPoint Geo UTCTime Double deriving Show
 
 loadTrackPoints :: FilePath -> IO [TrackPoint]
@@ -28,15 +27,6 @@ loadTrackPoints src = catMaybes <$> runX process
           >>>
           processDocumentRootElement
 
-data ElevPoint = ElevPoint
-                 { ptElev :: Double
-                 , ptDist :: Double
-                 , ptTime :: POSIXTime
-                 } deriving (Generic, Show)
-
-instance ToJSON ElevPoint where
-  toJSON (ElevPoint e s t) = object ["ele" .= e, "dist" .= s, "time" .= t]
-
 loadCalcElev :: FilePath -> IO [ElevPoint]
 loadCalcElev src = calcElev <$> loadTrackPoints src
 

Tour.hs → common/TourJson.hs

@@ -2,93 +2,41 @@
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 
-module Tour
-   ( Tour(..)
-   , TourDay(..)
-   , tourSummary
-   , tourDates
-   , tourDates'
-   , formatDate
-   , dashesDate
-   , undashesDate
-   ) where
+module TourJson where
 
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import Data.Time.Calendar (Day)
 import Data.Time.Format (parseTimeM, defaultTimeLocale, formatTime, iso8601DateFormat)
 import Data.Time.LocalTime (LocalTime, TimeOfDay)
-import Data.Time.LocalTime (LocalTime, TimeOfDay)
+import Data.Time.Clock.POSIX (POSIXTime)
+import Data.Time.Clock (NominalDiffTime)
 import Data.Map (Map, fromList)
 import Data.Maybe (catMaybes)
 import Data.List (intercalate)
 import Data.Aeson
-import Data.Aeson.Types (camelTo2, Options(..), Parser(..), typeMismatch)
+import Data.Aeson.Types
 import Data.Monoid
 import Control.Monad (forM)
-import Data.Yaml (encodeFile)
 import Data.Text (Text)
 import GHC.Generics
 import qualified Data.Map as M
 import qualified Data.Vector as V
 import Naqsha.Geometry
 import Data.Scientific (toRealFloat)
 
-data TourDay = TourDay
-    { dayNum  :: Int
-    , dayDate  :: Day
-    , dayStart :: Maybe TimeOfDay
-    , dayEnd   :: Maybe TimeOfDay
-    , dayFrom  :: Text
-    , dayTo    :: Text
-    , dayFromCoord :: Maybe Geo
-    , dayToCoord   :: Maybe Geo
-    , dayDist  :: Int
-    } deriving (Generic, Show)
-
-data Tour = Tour
-    { tourName  :: Text
-    , tourDescription :: Text
-    , tourDays  :: [TourDay]
-    , tourStart :: Maybe Day
-    , tourEnd  :: Maybe Day
-    , tourCountries :: [Text]
-    } deriving (Generic, Show)
-
-tourDates :: Tour -> [Day]
--- tourDates Tour{..} = catMaybes $ map (parseDate . dayDate) tourDays
-tourDates = map dayDate . tourDays
-
-tourDates' :: Tour -> [String]
-tourDates' = map formatDate . tourDates
-
-parseDate :: Text -> Maybe Day
-parseDate = parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack
-
-formatDate :: Day -> String
-formatDate = formatTime defaultTimeLocale (iso8601DateFormat Nothing)
-
-dashesDate :: String -> String
-dashesDate d = intercalate "-" [y, m, d']
-  where
-    (y, y') = splitAt 4 d
-    (m, m') = splitAt 2 y'
-    (d', _)  = splitAt 2 m'
-
-undashesDate :: String -> String
-undashesDate = filter (/= '-')
+import Types
 
 prefixOptions :: Options
-prefixOptions = defaultOptions { fieldLabelModifier = drop 1 . dropWhile (/= '_') . camelTo2 '_' }
+prefixOptions = defaultOptions { fieldLabelModifier = drop 1 . dropWhile (/= '_') . camel }
 
 instance ToJSON TourDay where
   toJSON = genericToJSON prefixOptions
-  toEncoding = genericToEncoding prefixOptions
 
 instance ToJSON Tour where
   toJSON = genericToJSON prefixOptions
-  toEncoding = genericToEncoding prefixOptions
 
 instance ToJSON Geo where
   toJSON (Geo lat' lon') = Array (V.fromList [num lon', num lat'])
@@ -146,11 +94,26 @@ instance FromJSON Latitude where
 instance FromJSON Longitude where
   parseJSON = parseCoord lon
 
-renumber :: [TourDay] -> [TourDay]
-renumber = id
-
-parseTimeOfDay :: Monad m => String -> m TimeOfDay
-parseTimeOfDay = parseTimeM True defaultTimeLocale "%l:%M"
-
-tourSummary :: [(String, Tour)] -> Map String Tour
-tourSummary = M.fromList . map (\(n, t) -> (n, t { tourDays = []}))
+instance ToJSON ElevPoint where
+  toJSON (ElevPoint e s t) = object ["ele" .= e, "dist" .= s, "time" .= t]
+
+----------------------------------------------------------------------------
+
+#if !MIN_VERSION_aeson(1,0,0)
+instance ToJSON Day where
+  toJSON _ = object []
+instance ToJSON TimeOfDay where
+  toJSON _ = object []
+instance ToJSON NominalDiffTime where
+  toJSON _ = object []
+instance FromJSON Day where
+  parseJSON _ = undefined
+instance FromJSON TimeOfDay where
+  parseJSON _ = undefined
+instance FromJSON NominalDiffTime where
+  parseJSON _ = undefined
+
+camel = camelTo '_'
+#else
+camel = camelTo2 '_'
+#endif

common/Types.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Types
+  ( Tour(..)
+  , TourDay(..)
+  , tourSummary
+  , tourDates
+  , tourDates'
+  , formatDate
+  , dashesDate
+  , undashesDate
+  , renumber
+  , ElevPoint(..)
+  ) where
+
+import qualified Data.Text as T
+import Data.Text (Text)
+import GHC.Generics
+import Data.Time.Calendar (Day)
+import Data.Time.Format (parseTimeM, defaultTimeLocale, formatTime, iso8601DateFormat)
+import Data.Time.LocalTime (LocalTime, TimeOfDay)
+import Data.Time.Clock.POSIX (POSIXTime)
+import Naqsha.Geometry
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.List (intercalate)
+
+data TourDay = TourDay
+    { dayNum  :: Int
+    , dayDate  :: Day
+    , dayStart :: Maybe TimeOfDay
+    , dayEnd   :: Maybe TimeOfDay
+    , dayFrom  :: Text
+    , dayTo    :: Text
+    , dayFromCoord :: Maybe Geo
+    , dayToCoord   :: Maybe Geo
+    , dayDist  :: Int
+    } deriving (Generic, Show, Eq)
+
+data Tour = Tour
+    { tourName  :: Text
+    , tourDescription :: Text
+    , tourDays  :: [TourDay]
+    , tourStart :: Maybe Day
+    , tourEnd  :: Maybe Day
+    , tourCountries :: [Text]
+    } deriving (Generic, Show, Eq)
+
+tourDates :: Tour -> [Day]
+-- tourDates Tour{..} = catMaybes $ map (parseDate . dayDate) tourDays
+tourDates = map dayDate . tourDays
+
+tourDates' :: Tour -> [String]
+tourDates' = map formatDate . tourDates
+
+parseDate :: Text -> Maybe Day
+parseDate = parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack
+
+formatDate :: Day -> String
+formatDate = formatTime defaultTimeLocale (iso8601DateFormat Nothing)
+
+dashesDate :: String -> String
+dashesDate d = intercalate "-" [y, m, d']
+  where
+    (y, y') = splitAt 4 d
+    (m, m') = splitAt 2 y'
+    (d', _)  = splitAt 2 m'
+
+undashesDate :: String -> String
+undashesDate = filter (/= '-')
+
+renumber :: [TourDay] -> [TourDay]
+renumber = id
+
+parseTimeOfDay :: Monad m => String -> m TimeOfDay
+parseTimeOfDay = parseTimeM True defaultTimeLocale "%l:%M"
+
+tourSummary :: [(String, Tour)] -> Map String Tour
+tourSummary = M.fromList . map (\(n, t) -> (n, t { tourDays = []}))
+
+data ElevPoint = ElevPoint
+                 { ptElev :: Double
+                 , ptDist :: Double
+                 , ptTime :: POSIXTime
+                 } deriving (Generic, Show)