Add type level format builder

src/Data/Formatter/DateTime.purs

@@ -1,6 +1,5 @@
 module Data.Formatter.DateTime
-  ( Formatter
-  , FormatterCommand(..)
+  ( module FMT
   , Meridiem
   , printFormatter
   , printFormatterCommand
@@ -10,10 +9,19 @@ module Data.Formatter.DateTime
   , unformat
   , unformatDateTime
   , unformatParser
+  , class PrintFormat
+  , printFormat
+  , fromDateFormatter
+  , fromTimeFormatter
   ) where
 
 import Prelude
 
+import Data.Formatter.DateTime.Types (FProxy, kind FormatList)
+import Data.Formatter.DateTime.Unsafe.Date (Formatter(..)) as FDate
+import Data.Formatter.DateTime.Unsafe.Formatter (class PrintFormatI, class ValidDateTime, printFormatI)
+import Data.Formatter.DateTime.Unsafe.Time (Formatter(..)) as FTime
+
 import Control.Alt ((<|>))
 import Control.Alternative (class Alternative)
 import Control.Apply (lift2)
@@ -28,11 +36,13 @@ import Data.DateTime.Instant (instant, toDateTime, fromDateTime, unInstant)
 import Data.Either (Either(..), either)
 import Data.Enum (fromEnum, toEnum)
 import Data.Foldable (foldMap)
+import Data.Formatter.DateTime.Unsafe.DateTime (Formatter(..))
+import Data.Formatter.DateTime.Unsafe.DateTime (Formatter) as FMT
+import Data.Formatter.DateTime.Commands (FormatterCommand(..))
+import Data.Formatter.DateTime.Commands (FormatterCommand(..)) as FMT
 import Data.Formatter.Internal (foldDigits)
 import Data.Formatter.Parser.Number (parseDigit)
 import Data.Formatter.Parser.Utils (runP, oneOfAs)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
 import Data.Int as Int
 import Data.List as List
 import Data.Maybe (Maybe(..), maybe, fromMaybe)
@@ -46,36 +56,6 @@ import Text.Parsing.Parser as P
 import Text.Parsing.Parser.Combinators as PC
 import Text.Parsing.Parser.String as PS
 
-data FormatterCommand
-  = YearFull
-  | YearTwoDigits
-  | YearAbsolute
-  | MonthFull
-  | MonthShort
-  | MonthTwoDigits
-  | DayOfMonthTwoDigits
-  | DayOfMonth
-  | UnixTimestamp
-  | DayOfWeek
-  | Hours24
-  | Hours12
-  | Meridiem
-  | Minutes
-  | MinutesTwoDigits
-  | Seconds
-  | SecondsTwoDigits
-  | Milliseconds
-  | MillisecondsShort
-  | MillisecondsTwoDigits
-  | Placeholder String
-
-derive instance eqFormatterCommand ∷ Eq (FormatterCommand)
-derive instance genericFormatter ∷ Generic FormatterCommand _
-instance showFormatter ∷ Show FormatterCommand where
-  show = genericShow
-
-type Formatter = List.List FormatterCommand
-
 printFormatterCommand ∷ FormatterCommand → String
 printFormatterCommand = case _ of
   YearFull → "YYYY"
@@ -101,7 +81,7 @@ printFormatterCommand = case _ of
   Placeholder s → s
 
 printFormatter ∷ Formatter → String
-printFormatter = foldMap printFormatterCommand
+printFormatter (Formatter fmt)= foldMap printFormatterCommand fmt
 
 parseFormatString ∷ String → Either String Formatter
 parseFormatString = runP formatParser
@@ -137,7 +117,7 @@ formatterCommandParser = (PC.try <<< PS.string) `oneOfAs`
   ] <|> (Placeholder <$> placeholderContent)
 
 formatParser ∷ P.Parser String Formatter
-formatParser = List.some formatterCommandParser
+formatParser = List.some formatterCommandParser <#> Formatter
 
 -- | Formatting function that accepts a number that is a year,
 -- | and strips away the non-significant digits, leaving only the
@@ -199,7 +179,7 @@ padQuadrupleDigit i
   | otherwise = show i
 
 format ∷ Formatter → DT.DateTime → String
-format f d = foldMap (formatCommand d) f
+format (Formatter fmt) d = foldMap (formatCommand d) fmt
 
 formatDateTime ∷ String → DT.DateTime → Either String String
 formatDateTime pattern datetime =
@@ -368,8 +348,8 @@ unformatCommandParser = case _ of
     lift $ modify (flip f (Just v))
 
 unformatParser ∷ ∀ m. Monad m ⇒ Formatter → P.ParserT String m DT.DateTime
-unformatParser f = do
-  acc ← P.mapParserT unState $ foldMap unformatCommandParser f
+unformatParser (Formatter fmt) = do
+  acc ← P.mapParserT unState $ foldMap unformatCommandParser fmt
   either P.fail pure $ unformatAccumToDateTime acc
   where
   unState ∷ ∀ x y n. Monad n ⇒ State UnformatAccum (Tuple (Either y Unit) x) → n (Tuple (Either y UnformatAccum) x)
@@ -436,3 +416,19 @@ printShortMonth = case _ of
   D.October → "Oct"
   D.November → "Nov"
   D.December → "Dec"
+
+
+class PrintFormat (fmt ∷ FormatList) where
+  printFormat ∷ FProxy fmt → Formatter
+
+instance pf ∷
+  ( ValidDateTime a
+  , PrintFormatI a
+  ) ⇒ PrintFormat a where
+  printFormat prx = Formatter $ printFormatI prx List.Nil
+
+fromDateFormatter ∷ FDate.Formatter -> Formatter
+fromDateFormatter (FDate.Formatter fmt) = Formatter fmt
+
+fromTimeFormatter ∷ FTime.Formatter -> Formatter
+fromTimeFormatter (FTime.Formatter fmt) = Formatter fmt

src/Data/Formatter/DateTime/Commands.purs

@@ -0,0 +1,34 @@
+module Data.Formatter.DateTime.Commands where
+
+import Prelude
+
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+
+data FormatterCommand
+  = YearFull
+  | YearTwoDigits
+  | YearAbsolute
+  | MonthFull
+  | MonthShort
+  | MonthTwoDigits
+  | DayOfMonthTwoDigits
+  | DayOfMonth
+  | UnixTimestamp
+  | DayOfWeek
+  | Hours24
+  | Hours12
+  | Meridiem
+  | Minutes
+  | MinutesTwoDigits
+  | Seconds
+  | SecondsTwoDigits
+  | Milliseconds
+  | MillisecondsShort
+  | MillisecondsTwoDigits
+  | Placeholder String
+
+derive instance eqFormatterCommand ∷ Eq FormatterCommand
+derive instance genericFormatterCommand ∷ Generic FormatterCommand _
+instance showFormatterCommand ∷ Show FormatterCommand where
+  show = genericShow

src/Data/Formatter/DateTime/Date.purs

@@ -0,0 +1,31 @@
+module Data.Formatter.DateTime.Date where
+
+import Prelude
+
+import Data.DateTime (DateTime(..), Date, date)
+import Data.Either (Either)
+import Data.Formatter.DateTime as FD
+import Data.Formatter.DateTime (fromDateFormatter)
+import Data.Formatter.DateTime.Unsafe.Date (Formatter(..)) as F
+import Data.Formatter.DateTime.Types (kind FormatList, FProxy)
+import Data.Formatter.DateTime.Unsafe.Formatter (class PrintFormatI, class ValidDate, printFormatI)
+import Data.List (List(..))
+
+format ∷ F.Formatter → Date → String
+format fmt x = FD.format (fromDateFormatter fmt) $ DateTime x bottom
+
+formatTime ∷ String → Date → Either String String
+formatTime fmt x = FD.formatDateTime fmt $ DateTime x bottom
+
+unformat ∷ F.Formatter → String → Either String Date
+unformat fmt x = FD.unformat (fromDateFormatter fmt) x <#> date
+
+unformatTime ∷ String → String → Either String Date
+unformatTime fmt x = FD.unformatDateTime fmt x <#> date
+
+
+class PrintFormat (fmt ∷ FormatList) where
+  printFormat ∷ FProxy fmt → F.Formatter
+
+instance pf ∷ (ValidDate a, PrintFormatI a) ⇒ PrintFormat a where
+  printFormat prx = F.Formatter $ printFormatI prx Nil

src/Data/Formatter/DateTime/Time.purs

@@ -0,0 +1,31 @@
+module Data.Formatter.DateTime.Time where
+
+import Prelude
+
+import Data.DateTime (DateTime(..), Time, time)
+import Data.Either (Either)
+import Data.Formatter.DateTime as FD
+import Data.Formatter.DateTime (fromTimeFormatter)
+import Data.Formatter.DateTime.Unsafe.Time (Formatter(..)) as F
+import Data.Formatter.DateTime.Types (kind FormatList, FProxy)
+import Data.Formatter.DateTime.Unsafe.Formatter (class PrintFormatI, class ValidTime, printFormatI)
+import Data.List (List(..))
+
+format ∷ F.Formatter → Time → String
+format fmt x = FD.format (fromTimeFormatter fmt) $ DateTime bottom x
+
+formatTime ∷ String → Time → Either String String
+formatTime fmt x = FD.formatDateTime fmt $ DateTime bottom x
+
+unformat ∷ F.Formatter → String → Either String Time
+unformat fmt x = FD.unformat (fromTimeFormatter fmt) x <#> time
+
+unformatTime ∷ String → String → Either String Time
+unformatTime fmt x = FD.unformatDateTime fmt x <#> time
+
+
+class PrintFormat (fmt ∷ FormatList) where
+  printFormat ∷ FProxy fmt → F.Formatter
+
+instance pf ∷ (ValidTime a, PrintFormatI a) ⇒ PrintFormat a where
+  printFormat prx = F.Formatter $ printFormatI prx Nil

src/Data/Formatter/DateTime/Types.purs

@@ -0,0 +1,62 @@
+module Data.Formatter.DateTime.Types
+  ( YearFull
+  , YearTwoDigits
+  , YearAbsolute
+  , MonthFull
+  , MonthShort
+  , MonthTwoDigits
+  , DayOfMonthTwoDigits
+  , DayOfMonth
+  , UnixTimestamp
+  , DayOfWeek
+  , Hours24
+  , Hours12
+  , Meridiem
+  , Minutes
+  , MinutesTwoDigits
+  , Seconds
+  , SecondsTwoDigits
+  , Milliseconds
+  , MillisecondsShort
+  , MillisecondsTwoDigits
+  , Placeholder
+  , FCons
+  , FNil
+  , type (:)
+  , FProxy(..)
+  , kind FormatAtom
+  , kind FormatList
+  ) where
+
+
+foreign import kind FormatAtom
+foreign import kind FormatList
+
+foreign import data FCons ∷ FormatAtom → FormatList → FormatList
+foreign import data FNil ∷ FormatList
+
+infixr 6 type FCons as :
+
+foreign import data YearFull ∷ FormatAtom
+foreign import data YearTwoDigits ∷ FormatAtom
+foreign import data YearAbsolute ∷ FormatAtom
+foreign import data MonthFull ∷ FormatAtom
+foreign import data MonthShort ∷ FormatAtom
+foreign import data MonthTwoDigits ∷ FormatAtom
+foreign import data DayOfMonthTwoDigits ∷ FormatAtom
+foreign import data DayOfMonth ∷ FormatAtom
+foreign import data UnixTimestamp ∷ FormatAtom
+foreign import data DayOfWeek ∷ FormatAtom
+foreign import data Hours24 ∷ FormatAtom
+foreign import data Hours12 ∷ FormatAtom
+foreign import data Meridiem ∷ FormatAtom
+foreign import data Minutes ∷ FormatAtom
+foreign import data MinutesTwoDigits ∷ FormatAtom
+foreign import data Seconds ∷ FormatAtom
+foreign import data SecondsTwoDigits ∷ FormatAtom
+foreign import data Milliseconds ∷ FormatAtom
+foreign import data MillisecondsShort ∷ FormatAtom
+foreign import data MillisecondsTwoDigits ∷ FormatAtom
+foreign import data Placeholder ∷ Symbol → FormatAtom
+
+data FProxy (a ∷ FormatList) = FProxy

src/Data/Formatter/DateTime/Unsafe/Date.purs

@@ -0,0 +1,14 @@
+module Data.Formatter.DateTime.Unsafe.Date where
+
+import Prelude
+
+import Data.Formatter.DateTime.Commands (FormatterCommand)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.List (List)
+
+newtype Formatter = Formatter (List FormatterCommand)
+derive instance eqFormatter ∷ Eq Formatter
+derive instance genericFormatter ∷ Generic Formatter _
+instance showFormatter ∷ Show Formatter where
+  show = genericShow

src/Data/Formatter/DateTime/Unsafe/DateTime.purs

@@ -0,0 +1,14 @@
+module Data.Formatter.DateTime.Unsafe.DateTime where
+
+import Prelude
+
+import Data.Formatter.DateTime.Commands (FormatterCommand)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.List (List)
+
+newtype Formatter = Formatter (List FormatterCommand)
+derive instance eqFormatter ∷ Eq Formatter
+derive instance genericFormatter ∷ Generic Formatter _
+instance showFormatter ∷ Show Formatter where
+  show = genericShow